diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -667,9 +667,26 @@ } saveInfo; } specPartState_; + // Some declaration processing can and should be deferred to + // ResolveExecutionParts() to avoid prematurely creating implicitly-typed + // local symbols that should be host associations. + struct DeferredDeclarationState { + // The content of each namelist group + std::list namelistGroups; + }; + DeferredDeclarationState *GetDeferredDeclarationState(bool add = false) { + if (!add && deferred_.find(&currScope()) == deferred_.end()) { + return nullptr; + } else { + return &deferred_.emplace(&currScope(), DeferredDeclarationState{}) + .first->second; + } + } + private: Scope *currScope_{nullptr}; FuncResultStack funcResultStack_{*this}; + std::map deferred_; }; class ModuleVisitor : public virtual ScopeHandler { @@ -960,6 +977,7 @@ void CheckEquivalenceSets(); bool CheckNotInBlock(const char *); bool NameIsKnownOrIntrinsic(const parser::Name &); + void FinishNamelists(); // Each of these returns a pointer to a resolved Name (i.e. with symbol) // or nullptr in case of error. @@ -4986,30 +5004,41 @@ if (!CheckNotInBlock("NAMELIST")) { // C1107 return false; } - - NamelistDetails details; - for (const auto &name : std::get>(x.t)) { - auto *symbol{FindSymbol(name)}; - if (!symbol) { - symbol = &MakeSymbol(name, ObjectEntityDetails{}); - ApplyImplicitRules(*symbol); - } else if (!ConvertToObjectEntity(*symbol)) { - SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); - } - symbol->GetUltimate().set(Symbol::Flag::InNamelist); - details.add_object(*symbol); - } - const auto &groupName{std::get(x.t)}; auto *groupSymbol{FindInScope(groupName)}; if (!groupSymbol || !groupSymbol->has()) { - groupSymbol = &MakeSymbol(groupName, std::move(details)); + groupSymbol = &MakeSymbol(groupName, NamelistDetails{}); groupSymbol->ReplaceName(groupName.source); } - groupSymbol->get().add_objects(details.objects()); + // Name resolution of group items is deferred to FinishNamelists() + // so that host association is handled correctly. + GetDeferredDeclarationState(true)->namelistGroups.emplace_back(&x); return false; } +void DeclarationVisitor::FinishNamelists() { + if (auto *deferred{GetDeferredDeclarationState()}) { + for (const parser::NamelistStmt::Group *group : deferred->namelistGroups) { + if (auto *groupSymbol{FindInScope(std::get(group->t))}) { + if (auto *details{groupSymbol->detailsIf()}) { + for (const auto &name : std::get>(group->t)) { + auto *symbol{FindSymbol(name)}; + if (!symbol) { + symbol = &MakeSymbol(name, ObjectEntityDetails{}); + ApplyImplicitRules(*symbol); + } else if (!ConvertToObjectEntity(*symbol)) { + SayWithDecl(name, *symbol, "'%s' is not a variable"_err_en_US); + } + symbol->GetUltimate().set(Symbol::Flag::InNamelist); + details->add_object(*symbol); + } + } + } + } + deferred->namelistGroups.clear(); + } +} + bool DeclarationVisitor::Pre(const parser::IoControlSpec &x) { if (const auto *name{std::get_if(&x.u)}) { auto *symbol{FindSymbol(*name)}; @@ -7447,6 +7476,7 @@ if (const auto *exec{node.exec()}) { Walk(*exec); } + FinishNamelists(); PopScope(); // converts unclassified entities into objects for (const auto &child : node.children()) { ResolveExecutionParts(child); diff --git a/flang/test/Semantics/call19.f90 b/flang/test/Semantics/call19.f90 --- a/flang/test/Semantics/call19.f90 +++ b/flang/test/Semantics/call19.f90 @@ -10,6 +10,7 @@ integer, len :: len end type type(pdt(1,2)) :: x + !ERROR: 'i' is not a variable namelist /nml/i contains subroutine s(d) diff --git a/flang/test/Semantics/resolve40.f90 b/flang/test/Semantics/resolve40.f90 --- a/flang/test/Semantics/resolve40.f90 +++ b/flang/test/Semantics/resolve40.f90 @@ -40,7 +40,6 @@ subroutine s5 namelist /nl/x - !ERROR: The type of 'x' has already been implicitly declared integer x end @@ -57,8 +56,8 @@ subroutine s7 real x + !ERROR: 'x' is not a variable namelist /nl/ x - !ERROR: EXTERNAL attribute not allowed on 'x' external x end