diff --git a/flang/lib/common/restorer.h b/flang/lib/common/restorer.h index b2b8686cd515..13e461838407 100644 --- a/flang/lib/common/restorer.h +++ b/flang/lib/common/restorer.h @@ -35,7 +35,7 @@ private: A original_; }; -template Restorer ScopedSet(A &to, A &&from) { +template Restorer ScopedSet(A &to, B &&from) { Restorer result{to}; to = std::move(from); return result; diff --git a/flang/lib/semantics/resolve-names.cc b/flang/lib/semantics/resolve-names.cc index 1478421f5c40..26f1a809317e 100644 --- a/flang/lib/semantics/resolve-names.cc +++ b/flang/lib/semantics/resolve-names.cc @@ -24,6 +24,7 @@ #include "../common/default-kinds.h" #include "../common/fortran.h" #include "../common/indirection.h" +#include "../common/restorer.h" #include "../evaluate/common.h" #include "../evaluate/fold.h" #include "../evaluate/tools.h" @@ -712,6 +713,7 @@ protected: const parser::Name &, const std::optional &); bool CheckUseError(const parser::Name &); void CheckAccessibility(const parser::Name &, bool, const Symbol &); + bool CheckAccessibleComponent(const SourceName &, const Symbol &); void CheckScalarIntegerType(const parser::Name &); void CheckCommonBlocks(); @@ -959,7 +961,6 @@ private: const parser::Name *ResolveName(const parser::Name &); const parser::Name *FindComponent(const parser::Name *, const parser::Name &); - bool CheckAccessibleComponent(const parser::Name &); void CheckImports(); void CheckImport(const SourceName &, const SourceName &); bool SetProcFlag(const parser::Name &, Symbol &); @@ -1538,8 +1539,13 @@ Symbol &ScopeHandler::Resolve(const parser::Name &name, Symbol &symbol) { return *Resolve(name, &symbol); } Symbol *ScopeHandler::Resolve(const parser::Name &name, Symbol *symbol) { - if (symbol && !name.symbol) { - name.symbol = symbol; + if (symbol) { + // TODO: Should name.symbol be unconditionally updated? + // Or should it be an internal error if name.symbol is + // set to a distinct symbol? + if (name.symbol == nullptr) { + name.symbol = symbol; + } } return symbol; } @@ -2384,6 +2390,37 @@ void DeclarationVisitor::CheckAccessibility( } } +// Check that component is accessible from current scope. +bool DeclarationVisitor::CheckAccessibleComponent( + const SourceName &name, const Symbol &symbol) { + if (!symbol.attrs().test(Attr::PRIVATE)) { + return true; + } + // component must be in a module/submodule because of PRIVATE: + const Scope *moduleScope{&symbol.owner()}; + CHECK(moduleScope->kind() == Scope::Kind::DerivedType); + while (moduleScope->kind() != Scope::Kind::Module && + moduleScope->kind() != Scope::Kind::Global) { + moduleScope = &moduleScope->parent(); + } + if (moduleScope->kind() == Scope::Kind::Module) { + for (auto *scope{&currScope()}; scope->kind() != Scope::Kind::Global; + scope = &scope->parent()) { + if (scope == moduleScope) { + return true; + } + } + Say(name, + "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US, + name.ToString(), moduleScope->name()); + } else { + Say(name, + "PRIVATE component '%s' is only accessible within its module"_err_en_US, + name.ToString()); + } + return false; +} + void DeclarationVisitor::CheckScalarIntegerType(const parser::Name &name) { if (name.symbol != nullptr) { const Symbol &symbol{*name.symbol}; @@ -2829,6 +2866,11 @@ void DeclarationVisitor::Post(const parser::DerivedTypeStmt &x) { if (auto *extendsName{derivedTypeInfo_.extends}) { if (const Symbol * extends{ResolveDerivedType(*extendsName)}) { // Declare the "parent component"; private if the type is + // Any symbol stored in the EXTENDS() clause is temporarily + // hidden so that a new symbol can be created for the parent + // component without producing spurious errors about already + // existing. + auto restorer{common::ScopedSet(extendsName->symbol, nullptr)}; if (OkToAddComponent(*extendsName, extends)) { auto &comp{DeclareEntity(*extendsName, Attrs{})}; comp.attrs().set(Attr::PRIVATE, extends->attrs().test(Attr::PRIVATE)); @@ -3071,64 +3113,84 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { EndDeclTypeSpec(); SetDeclTypeSpecState(savedState); - bool ok{typeSymbol != nullptr && typeScope != nullptr}; + // This list holds all of the components in the derived type and its + // parents. The symbols for whole parent components appear after their + // own components and before the components of the types that extend them. + // E.g., TYPE :: A; REAL X; END TYPE + // TYPE, EXTENDS(A) :: B; REAL Y; END TYPE + // produces the component list X, A, Y. + // The order is important below because a structure constructor can + // initialize X or A by name, but not both. SymbolList components; + bool ok{typeSymbol != nullptr && typeScope != nullptr}; if (ok) { - // This list holds all of the components in the derived type and its - // parents. The symbols for whole parent components appear after their - // own components and before the components of the types that extend them. - // E.g., TYPE :: A; REAL X; END TYPE - // TYPE, EXTENDS(A) :: B; REAL Y; END TYPE - // produces the component list X, A, Y. - // The order is important below because a structure constructor can - // initialize X or A by name, but not both. components = typeSymbol->get().OrderComponents(*typeScope); + if (typeSymbol->attrs().test(Attr::ABSTRACT)) { // C796 + SayWithDecl(typeName, *typeSymbol, + "ABSTRACT type cannot be used in a structure constructor"_err_en_US); + } } + // N.B C7102 is implicitly enforced by having inaccessible types not + // being found in resolution. + std::set unavailable; auto nextAnonymous{components.begin()}; bool anyKeyword{false}; for (const auto &component : std::get>(x.t)) { - Walk(component); + // Visit the component spec expression, but not the keyword, since + // we need to resolve its symbol in the scope of the derived type. const parser::Expr &value{ *std::get(component.t).v}; + Walk(value); const auto &kw{std::get>(component.t)}; const Symbol *symbol{nullptr}; + SourceName source{value.source}; + auto componentIter{components.end()}; if (kw.has_value()) { - symbol = kw->v.symbol; + source = kw->v.source; + componentIter = std::find_if(components.begin(), components.end(), + [&](const Symbol *s) { return s->name() == source; }); + if (componentIter != components.end()) { + if ((*componentIter)->has()) { + Say(source, + "Type parameter '%s' cannot appear in a structure constructor"_err_en_US); + } else { + symbol = *componentIter; + } + } else { // C7101 + Say(source, + "Keyword '%s' is not a component of this derived type"_err_en_US); + } anyKeyword = true; - } else if (anyKeyword) { - Say(value.source, - "Component value lacks a required component name"_err_en_US); + ok &= symbol != nullptr; + } else if (anyKeyword) { // C7100 + Say(source, + "Value in structure constructor lacks a required component name"_err_en_US); } if (symbol != nullptr) { + CHECK(componentIter != components.end()); if (unavailable.find(symbol->name()) != unavailable.cend()) { - Say(kw->v.source, - "Component '%s' conflicts with another component earlier in the constructor"_err_en_US); + // C797, C798 + Say(source, + "Component '%s' conflicts with another component earlier in the structure constructor"_err_en_US); + } else if (symbol->test(Symbol::Flag::ParentComp)) { + // Make earlier components unavailable once a whole parent appears. + for (auto it{components.begin()}; it != componentIter; ++it) { + unavailable.insert((*it)->name()); + } } else { - auto iter{std::find(components.begin(), components.end(), symbol)}; - if (iter == components.end()) { - Say(kw->v.source, - "Component '%s' is not a component of this derived type"_err_en_US); - symbol = nullptr; - } else if (symbol->test(Symbol::Flag::ParentComp)) { - // Make earlier components unavailable once a whole parent appears. - for (auto it{components.begin()}; it != iter; ++it) { + // Make whole parent components unavailable after any of their + // constituents appear. + for (auto it{componentIter}; it != components.end(); ++it) { + if ((*it)->test(Symbol::Flag::ParentComp)) { unavailable.insert((*it)->name()); } - } else { - // Make whole parent components unavailable after any of their - // constituents appear. - for (auto it{iter}; it != components.end(); ++it) { - if ((*it)->test(Symbol::Flag::ParentComp)) { - unavailable.insert((*it)->name()); - } - } } } - } else { + } else if (ok) { while (nextAnonymous != components.end()) { symbol = *nextAnonymous++; if (symbol->test(Symbol::Flag::ParentComp)) { @@ -3138,27 +3200,30 @@ bool DeclarationVisitor::Pre(const parser::StructureConstructor &x) { } } if (symbol == nullptr) { - Say(value.source, - "Unexpected value does not correspond to any component"_err_en_US); + Say(source, "Unexpected value in structure constructor"_err_en_US); break; } } - // Save the resolved component's symbol (if any) in the parse tree. if (symbol != nullptr) { + // Save the resolved component's symbol (if any) in the parse tree. component.symbol = symbol; unavailable.insert(symbol->name()); + CheckAccessibleComponent(source, *symbol); // C7102 + // TODO pmk: C7104, C7105 check that pointer components are + // being initialized with data/procedure designators appropriately } } // Ensure that unmentioned component objects have default initializers. - for (const Symbol *symbol : components) { - if (!symbol->test(Symbol::Flag::ParentComp) && - unavailable.find(symbol->name()) == unavailable.cend() && - !symbol->attrs().test(Attr::POINTER) && - !symbol->attrs().test(Attr::ALLOCATABLE)) { - if (const auto *details{symbol->detailsIf()}) { - if (!details->init().has_value()) { - Say2(typeName, "Structure constructor lacks a value"_err_en_US, - *symbol, "Absent component"_en_US); + if (ok) { + for (const Symbol *symbol : components) { + if (!symbol->test(Symbol::Flag::ParentComp) && + unavailable.find(symbol->name()) == unavailable.cend() && + !symbol->attrs().test(Attr::ALLOCATABLE)) { + if (const auto *details{symbol->detailsIf()}) { + if (!details->init().has_value()) { // C799 + Say2(typeName, "Structure constructor lacks a value"_err_en_US, + *symbol, "Absent component"_en_US); + } } } } @@ -4030,8 +4095,8 @@ const parser::Name *ResolveNamesVisitor::FindComponent( } } else if (const DerivedTypeSpec * derived{type->AsDerived()}) { if (const Scope * scope{derived->scope()}) { - if (FindInTypeOrParents(*scope, component)) { - if (CheckAccessibleComponent(component)) { + if (Resolve(component, FindInTypeOrParents(*scope, component.source))) { + if (CheckAccessibleComponent(component.source, *component.symbol)) { return &component; } } else { @@ -4051,30 +4116,6 @@ const parser::Name *ResolveNamesVisitor::FindComponent( return nullptr; } -// Check that component is accessible from current scope. -bool ResolveNamesVisitor::CheckAccessibleComponent( - const parser::Name &component) { - CHECK(component.symbol); - auto &symbol{*component.symbol}; - if (!symbol.attrs().test(Attr::PRIVATE)) { - return true; - } - CHECK(symbol.owner().kind() == Scope::Kind::DerivedType); - // component must be in a module/submodule because of PRIVATE: - const Scope &moduleScope{symbol.owner().parent()}; - CHECK(moduleScope.kind() == Scope::Kind::Module); - for (auto *scope{&currScope()}; scope->kind() != Scope::Kind::Global; - scope = &scope->parent()) { - if (scope == &moduleScope) { - return true; - } - } - Say(component, - "PRIVATE component '%s' is only accessible within module '%s'"_err_en_US, - component.ToString(), moduleScope.name()); - return false; -} - void ResolveNamesVisitor::Post(const parser::ProcedureDesignator &x) { if (const auto *name{std::get_if(&x.u)}) { auto *symbol{FindSymbol(*name)}; diff --git a/flang/lib/semantics/scope.cc b/flang/lib/semantics/scope.cc index 70dc50a5e371..4f39bef94507 100644 --- a/flang/lib/semantics/scope.cc +++ b/flang/lib/semantics/scope.cc @@ -49,7 +49,7 @@ Symbol *Scope::FindSymbol(const SourceName &name) const { if (kind() == Kind::DerivedType) { return parent_.FindSymbol(name); } - const auto it{find(name)}; + auto it{find(name)}; if (it != end()) { return it->second; } else if (CanImport(name)) { diff --git a/flang/lib/semantics/symbol.cc b/flang/lib/semantics/symbol.cc index b57ef3ebdfe6..932e84bc3323 100644 --- a/flang/lib/semantics/symbol.cc +++ b/flang/lib/semantics/symbol.cc @@ -640,12 +640,10 @@ SymbolList DerivedTypeDetails::OrderComponents(const Scope &scope) const { const Symbol &symbol{*iter->second}; if (symbol.test(Symbol::Flag::ParentComp)) { CHECK(result.empty()); - const Symbol &typeSymbol{symbol.get() - .type() - ->AsDerived() - ->typeSymbol()}; - result = typeSymbol.get().OrderComponents( - *typeSymbol.scope()); + const DerivedTypeSpec &spec{ + *symbol.get().type()->AsDerived()}; + result = spec.typeSymbol().get().OrderComponents( + *spec.scope()); } result.push_back(&symbol); } diff --git a/flang/test/semantics/CMakeLists.txt b/flang/test/semantics/CMakeLists.txt index 7789bc080e72..5569ca4544bb 100644 --- a/flang/test/semantics/CMakeLists.txt +++ b/flang/test/semantics/CMakeLists.txt @@ -68,6 +68,7 @@ set(ERROR_TESTS resolve40.f90 resolve41.f90 resolve42.f90 + resolve43.f90 ) # These test files have expected symbols in the source diff --git a/flang/test/semantics/resolve41.f90 b/flang/test/semantics/resolve41.f90 index 9f6a56331bd7..44add6d0d58b 100644 --- a/flang/test/semantics/resolve41.f90 +++ b/flang/test/semantics/resolve41.f90 @@ -11,6 +11,7 @@ ! 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. + module m implicit none real, parameter :: a = 8.0 diff --git a/flang/test/semantics/resolve43.f90 b/flang/test/semantics/resolve43.f90 new file mode 100644 index 000000000000..92178cbf06df --- /dev/null +++ b/flang/test/semantics/resolve43.f90 @@ -0,0 +1,86 @@ +! 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. +! Type parameters are also used to make the parses unambiguous. + +module module1 + type :: type1(j) + integer, kind :: j + integer :: n = 1 + end type type1 + type, extends(type1) :: type2(k) + integer, kind :: k + integer :: m + end type type2 + type, abstract :: abstract(j) + integer, kind :: j + integer :: n + end type abstract + type :: privaten(j) + integer, kind :: j + integer, private :: n + end type privaten + contains + subroutine type1arg(x) + type(type1(0)), intent(in) :: x + end subroutine type1arg + subroutine type2arg(x) + type(type2(0,0)), intent(in) :: x + end subroutine type2arg + subroutine abstractarg(x) + type(abstract(0)), intent(in) :: x + end subroutine abstractarg + subroutine errors + call type1arg(type1(0)()) + call type1arg(type1(0)(1)) + call type1arg(type1(0)(n=1)) + !ERROR: Keyword 'bad' is not a component of this derived type + call type1arg(type1(0)(bad=1)) + !ERROR: Keyword 'j' is not a component of this derived type + call type1arg(type1(0)(j=1)) + !ERROR: Unexpected value in structure constructor + call type1arg(type1(0)(1,2)) + !ERROR: Component 'n' conflicts with another component earlier in the structure constructor + call type1arg(type1(0)(1,n=2)) + !ERROR: Value in structure constructor lacks a required component name + call type1arg(type1(0)(n=1,2)) + !ERROR: Component 'n' conflicts with another component earlier in the structure constructor + call type1arg(type1(0)(n=1,n=2)) + call type2arg(type2(0,0)(n=1,m=2)) + call type2arg(type2(0,0)(m=2)) + !ERROR: Structure constructor lacks a value + call type2arg(type2(0,0)()) + call type2arg(type2(0,0)(type1=type1(0)(n=1),m=2)) + call type2arg(type2(0,0)(type1=type1(0)(),m=2)) + !ERROR: Component 'type1' conflicts with another component earlier in the structure constructor + call type2arg(type2(0,0)(n=1,type1=type1(0)(n=2),m=3)) + !ERROR: Component 'n' conflicts with another component earlier in the structure constructor + call type2arg(type2(0,0)(type1=type1(0)(n=1),n=2,m=3)) + !ERROR: Component 'n' conflicts with another component earlier in the structure constructor + call type2arg(type2(0,0)(type1=type1(0)(1),n=2,m=3)) + !ERROR: Keyword 'j' is not a component of this derived type + call type2arg(type2(0,0)(j=1, & + !ERROR: Keyword 'k' is not a component of this derived type + k=2,m=3)) + !ERROR: ABSTRACT type cannot be used in a structure constructor + call abstractarg(abstract(0)(n=1)) + end subroutine errors +end module module1 + +subroutine yotdau + use module1 + !ERROR: PRIVATE component 'n' is only accessible within its module + type(privaten(0)) :: x = privaten(0)(n=1) +end subroutine yotdau