From e3b632337d0733673ae7458e2d6928ee2c3a1201 Mon Sep 17 00:00:00 2001 From: peter klausler Date: Fri, 8 Mar 2019 15:16:30 -0800 Subject: [PATCH] [flang] add structconst04.f90 test and fixes to pass it Original-commit: flang-compiler/f18@d857c843f5ef2125e9675eb22f013b225a399a38 Reviewed-on: https://github.com/flang-compiler/f18/pull/322 Tree-same-pre-rewrite: false --- flang/lib/parser/parse-tree.cc | 23 +++-- flang/lib/parser/parse-tree.h | 3 +- flang/lib/semantics/expression.cc | 34 ++++--- flang/lib/semantics/scope.h | 4 +- flang/test/semantics/CMakeLists.txt | 1 + flang/test/semantics/structconst03.f90 | 2 + flang/test/semantics/structconst04.f90 | 162 +++++++++++++++++++++++++++++++++ 7 files changed, 203 insertions(+), 26 deletions(-) create mode 100644 flang/test/semantics/structconst04.f90 diff --git a/flang/lib/parser/parse-tree.cc b/flang/lib/parser/parse-tree.cc index 17b6f57..2aeadf4 100644 --- a/flang/lib/parser/parse-tree.cc +++ b/flang/lib/parser/parse-tree.cc @@ -89,7 +89,8 @@ static Designator MakeArrayElementRef(Name &name, std::list &subscripts) { return Designator{DataRef{common::Indirection{std::move(arrayElement)}}}; } -static std::optional ActualArgToExpr(ActualArgSpec &arg) { +static std::optional ActualArgToExpr( + parser::CharBlock at, ActualArgSpec &arg) { return std::visit( common::visitors{ [&](common::Indirection &y) { @@ -98,8 +99,9 @@ static std::optional ActualArgToExpr(ActualArgSpec &arg) { [&](common::Indirection &y) { return std::visit( [&](auto &indirection) { - return std::make_optional( - std::move(indirection.value())); + std::optional result{std::move(indirection.value())}; + result->source = at; + return result; }, y.value().u); }, @@ -112,12 +114,13 @@ Designator FunctionReference::ConvertToArrayElementRef() { auto &name{std::get(std::get(v.t).u)}; std::list args; for (auto &arg : std::get>(v.t)) { - args.emplace_back(std::move(ActualArgToExpr(arg).value())); + args.emplace_back(std::move(ActualArgToExpr(name.source, arg).value())); } return MakeArrayElementRef(name, args); } -StructureConstructor FunctionReference::ConvertToStructureConstructor() { +StructureConstructor FunctionReference::ConvertToStructureConstructor( + const semantics::DerivedTypeSpec &derived) { Name name{std::get(std::get(v.t).u)}; std::list components; for (auto &arg : std::get>(v.t)) { @@ -125,12 +128,12 @@ StructureConstructor FunctionReference::ConvertToStructureConstructor() { if (auto &kw{std::get>(arg.t)}) { keyword.emplace(Keyword{Name{kw->v}}); } - components.emplace_back( - std::move(keyword), ComponentDataSource{ActualArgToExpr(arg).value()}); + components.emplace_back(std::move(keyword), + ComponentDataSource{ActualArgToExpr(name.source, arg).value()}); } - return StructureConstructor{ - DerivedTypeSpec{std::move(name), std::list{}}, - std::move(components)}; + DerivedTypeSpec spec{std::move(name), std::list{}}; + spec.derivedTypeSpec = &derived; + return StructureConstructor{std::move(spec), std::move(components)}; } // R1544 stmt-function-stmt diff --git a/flang/lib/parser/parse-tree.h b/flang/lib/parser/parse-tree.h index 5bdff06..2ef44b2 100644 --- a/flang/lib/parser/parse-tree.h +++ b/flang/lib/parser/parse-tree.h @@ -3092,7 +3092,8 @@ struct Call { struct FunctionReference { WRAPPER_CLASS_BOILERPLATE(FunctionReference, Call); Designator ConvertToArrayElementRef(); - StructureConstructor ConvertToStructureConstructor(); + StructureConstructor ConvertToStructureConstructor( + const semantics::DerivedTypeSpec &); }; // R1521 call-stmt -> CALL procedure-designator [( [actual-arg-spec-list] )] diff --git a/flang/lib/semantics/expression.cc b/flang/lib/semantics/expression.cc index 7be75a5..b17924f 100644 --- a/flang/lib/semantics/expression.cc +++ b/flang/lib/semantics/expression.cc @@ -1204,7 +1204,7 @@ MaybeExpr ExpressionAnalyzer::Analyze( auto &parsedType{std::get(structure.t)}; parser::CharBlock typeName{std::get(parsedType.t).source}; if (parsedType.derivedTypeSpec == nullptr) { - Say("INTERNAL: StructureConstructor lacks type"_err_en_US); + Say("INTERNAL: parser::StructureConstructor lacks type"_err_en_US); return std::nullopt; } const auto &spec{*parsedType.derivedTypeSpec}; @@ -1213,7 +1213,8 @@ MaybeExpr ExpressionAnalyzer::Analyze( if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796 if (auto *msg{Say(typeName, - "ABSTRACT derived type '%s' cannot be used in a structure constructor"_err_en_US, + "ABSTRACT derived type '%s' cannot be used in a " + "structure constructor"_err_en_US, typeName.ToString().data())}) { msg->Attach( typeSymbol.name(), "Declaration of ABSTRACT derived type"_en_US); @@ -1752,8 +1753,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::DefinedBinary &) { return std::nullopt; } -// Converts, if appropriate, a misparse of the ambiguous syntax A(1) as -// a function reference into an array reference or a structure constructor. +// Converts, if appropriate, an original misparse of ambiguous syntax like +// A(1) as a function reference into an array reference or a structure +// constructor. template void FixMisparsedFunctionReference(const std::variant &constU) { // The parse tree is updated in situ when resolving an ambiguous parse. @@ -1768,19 +1770,25 @@ void FixMisparsedFunctionReference(const std::variant &constU) { return; } Symbol &symbol{name->symbol->GetUltimate()}; - if constexpr (common::HasMember, - uType>) { - if (symbol.has()) { + if (symbol.has()) { + if constexpr (common::HasMember, + uType>) { u = common::Indirection{funcRef.ConvertToArrayElementRef()}; - return; // N.B. Expression semantics will reinterpret an array element // reference as a single-character substring elsewhere if necessary. + } else { + common::die("can't fix misparsed function as array reference"); } - } - if constexpr (common::HasMember) { - if (symbol.has()) { - u = funcRef.ConvertToStructureConstructor(); - return; + } else if (symbol.has()) { + if constexpr (common::HasMember) { + CHECK(symbol.scope() != nullptr); + const semantics::DeclTypeSpec *type{ + symbol.scope()->FindInstantiatedDerivedType( + semantics::DerivedTypeSpec{symbol})}; + CHECK(type != nullptr); + u = funcRef.ConvertToStructureConstructor(type->derivedTypeSpec()); + } else { + common::die("can't fix misparsed function as structure constructor"); } } } diff --git a/flang/lib/semantics/scope.h b/flang/lib/semantics/scope.h index cb107df..5fe3dee 100644 --- a/flang/lib/semantics/scope.h +++ b/flang/lib/semantics/scope.h @@ -175,8 +175,8 @@ public: const Scope *FindScope(const parser::CharBlock &) const; // Attempts to find a match for a derived type instance - const DeclTypeSpec *FindInstantiatedDerivedType( - const DerivedTypeSpec &, DeclTypeSpec::Category) const; + const DeclTypeSpec *FindInstantiatedDerivedType(const DerivedTypeSpec &, + DeclTypeSpec::Category = DeclTypeSpec::TypeDerived) const; // Returns a matching derived type instance if one exists, otherwise // creates one diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 365e661..b5f582f 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -75,6 +75,7 @@ set(ERROR_TESTS structconst01.f90 structconst02.f90 structconst03.f90 + structconst04.f90 assign01.f90 ) diff --git a/flang/test/semantics/structconst03.f90 b/flang/test/semantics/structconst03.f90 index 8166cb1..7a19575 100644 --- a/flang/test/semantics/structconst03.f90 +++ b/flang/test/semantics/structconst03.f90 @@ -14,6 +14,8 @@ ! Error tests for structure constructors: C1594 violations ! from assigning globally-visible data to POINTER components. +! test/semantics/structconst04.f90 is this same test without type +! parameters. module usefrom real :: usedfrom1 diff --git a/flang/test/semantics/structconst04.f90 b/flang/test/semantics/structconst04.f90 new file mode 100644 index 0000000..68c722c --- /dev/null +++ b/flang/test/semantics/structconst04.f90 @@ -0,0 +1,162 @@ +! Copyright (c) 2019, NVIDIA CORPORATION. All rights reserved. +! +! Licensed under the Apache License, Version 2.0 (the "License"); +! you may not use this file except in compliance with the License. +! You may obtain a copy of the License at +! +! http://www.apache.org/licenses/LICENSE-2.0 +! +! Unless required by applicable law or agreed to in writing, software +! distributed under the License is distributed on an "AS IS" BASIS, +! WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +! See the License for the specific language governing permissions and +! limitations under the License. + +! Error tests for structure constructors: C1594 violations +! from assigning globally-visible data to POINTER components. +! This test is structconst03.f90 with the type parameters removed. + +module usefrom + real :: usedfrom1 +end module usefrom + +module module1 + use usefrom + implicit none + type :: has_pointer1 + real, pointer :: ptop + type(has_pointer1), allocatable :: link1 ! don't loop during analysis + end type has_pointer1 + type :: has_pointer2 + type(has_pointer1) :: pnested + type(has_pointer2), allocatable :: link2 + end type has_pointer2 + type, extends(has_pointer2) :: has_pointer3 + type(has_pointer3), allocatable :: link3 + end type has_pointer3 + type :: t1 + real, pointer :: pt1 + type(t1), allocatable :: link + end type t1 + type :: t2 + type(has_pointer1) :: hp1 + type(t2), allocatable :: link + end type t2 + type :: t3 + type(has_pointer2) :: hp2 + type(t3), allocatable :: link + end type t3 + type :: t4 + type(has_pointer3) :: hp3 + type(t4), allocatable :: link + end type t4 + real :: modulevar1 + type(has_pointer1) :: modulevar2 + type(has_pointer2) :: modulevar3 + type(has_pointer3) :: modulevar4 + + contains + + pure real function pf1(dummy1, dummy2, dummy3, dummy4) + real :: local1 + type(t1) :: x1 + type(t2) :: x2 + type(t3) :: x3 + type(t4) :: x4 + real, intent(in) :: dummy1 + real, intent(inout) :: dummy2 + real, pointer :: dummy3 + real, intent(inout) :: dummy4[*] + real :: commonvar1 + common /cblock/ commonvar1 + pf1 = 0. + x1 = t1(local1) + !ERROR: Externally visible object 'usedfrom1' must not be associated with pointer component 'pt1' in a PURE function + x1 = t1(usedfrom1) + !ERROR: Externally visible object 'modulevar1' must not be associated with pointer component 'pt1' in a PURE function + x1 = t1(modulevar1) + !ERROR: Externally visible object 'cblock' must not be associated with pointer component 'pt1' in a PURE function + x1 = t1(commonvar1) + !ERROR: Externally visible object 'dummy1' must not be associated with pointer component 'pt1' in a PURE function + x1 = t1(dummy1) + x1 = t1(dummy2) + !ERROR: Externally visible object 'dummy3' must not be associated with pointer component 'pt1' in a PURE function + x1 = t1(dummy3) +! TODO when semantics handles coindexing: +! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function +! TODO x1 = t1(dummy4[0]) + x1 = t1(dummy4) + !ERROR: Externally visible object 'modulevar2' must not be associated with pointer component 'ptop' in a PURE function + x2 = t2(modulevar2) + !ERROR: Externally visible object 'modulevar3' must not be associated with pointer component 'ptop' in a PURE function + x3 = t3(modulevar3) + !ERROR: Externally visible object 'modulevar4' must not be associated with pointer component 'ptop' in a PURE function + x4 = t4(modulevar4) + contains + subroutine subr(dummy1a, dummy2a, dummy3a, dummy4a) + real :: local1a + type(t1) :: x1a + type(t2) :: x2a + type(t3) :: x3a + type(t4) :: x4a + real, intent(in) :: dummy1a + real, intent(inout) :: dummy2a + real, pointer :: dummy3a + real, intent(inout) :: dummy4a[*] + x1a = t1(local1a) + !ERROR: Externally visible object 'usedfrom1' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(usedfrom1) + !ERROR: Externally visible object 'modulevar1' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(modulevar1) + !ERROR: Externally visible object 'cblock' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(commonvar1) + !ERROR: Externally visible object 'dummy1' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(dummy1) + !ERROR: Externally visible object 'dummy1a' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(dummy1a) + x1a = t1(dummy2a) + !ERROR: Externally visible object 'dummy3' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(dummy3) + !ERROR: Externally visible object 'dummy3a' must not be associated with pointer component 'pt1' in a PURE function + x1a = t1(dummy3a) +! TODO when semantics handles coindexing: +! TODO !ERROR: Externally visible object must not be associated with a pointer in a PURE function +! TODO x1a = t1(dummy4a[0]) + x1a = t1(dummy4a) + !ERROR: Externally visible object 'modulevar2' must not be associated with pointer component 'ptop' in a PURE function + x2a = t2(modulevar2) + !ERROR: Externally visible object 'modulevar3' must not be associated with pointer component 'ptop' in a PURE function + x3a = t3(modulevar3) + !ERROR: Externally visible object 'modulevar4' must not be associated with pointer component 'ptop' in a PURE function + x4a = t4(modulevar4) + end subroutine subr + end function pf1 + + impure real function ipf1(dummy1, dummy2, dummy3, dummy4) + real :: local1 + type(t1) :: x1 + type(t2) :: x2 + type(t3) :: x3 + type(t4) :: x4 + real, intent(in) :: dummy1 + real, intent(inout) :: dummy2 + real, pointer :: dummy3 + real, intent(inout) :: dummy4[*] + real :: commonvar1 + common /cblock/ commonvar1 + ipf1 = 0. + x1 = t1(local1) + x1 = t1(usedfrom1) + x1 = t1(modulevar1) + x1 = t1(commonvar1) + x1 = t1(dummy1) + x1 = t1(dummy2) + x1 = t1(dummy3) +! TODO when semantics handles coindexing: +! TODO x1 = t1(dummy4[0]) + x1 = t1(dummy4) + x2 = t2(modulevar2) + x3 = t3(modulevar3) + x4 = t4(modulevar4) + end function ipf1 +end module module1 -- 2.7.4