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 @@ -135,14 +135,15 @@ // + AttrsVisitor // | + DeclTypeSpecVisitor // | + ImplicitRulesVisitor -// | + ScopeHandler -----------+--+ -// | + ModuleVisitor ========|==+ -// | + InterfaceVisitor | | -// | +-+ SubprogramVisitor ==|==+ -// + ArraySpecVisitor | | -// + DeclarationVisitor <--------+ | -// + ConstructVisitor | -// + ResolveNamesVisitor <------+ +// | + ScopeHandler ------------------+ +// | + ModuleVisitor -------------+ | +// | + GenericHandler -------+ | | +// | | + InterfaceVisitor | | | +// | +-+ SubprogramVisitor ==|==+ | | +// + ArraySpecVisitor | | | | +// + DeclarationVisitor <--------+ | | | +// + ConstructVisitor | | | +// + ResolveNamesVisitor <------+-+-+ class BaseVisitor { public: @@ -809,7 +810,23 @@ Scope *ancestor = nullptr); }; -class InterfaceVisitor : public virtual ScopeHandler { +class GenericHandler : public virtual ScopeHandler { +protected: + using ProcedureKind = parser::ProcedureStmt::Kind; + void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart); + void DeclaredPossibleSpecificProc(Symbol &); + + // Mappings of generics to their as-yet specific proc names and kinds + using SpecificProcMapType = + std::multimap>; + SpecificProcMapType specificsForGenericProcs_; + // inversion of SpecificProcMapType: maps pending proc names to generics + using GenericProcMapType = std::multimap; + GenericProcMapType genericsForSpecificProcs_; +}; + +class InterfaceVisitor : public virtual ScopeHandler, + public virtual GenericHandler { public: bool Pre(const parser::InterfaceStmt &); void Post(const parser::InterfaceStmt &); @@ -840,15 +857,7 @@ std::stack genericInfo_; const GenericInfo &GetGenericInfo() const { return genericInfo_.top(); } void SetGenericSymbol(Symbol &symbol) { genericInfo_.top().symbol = &symbol; } - - using ProcedureKind = parser::ProcedureStmt::Kind; - // mapping of generic to its specific proc names and kinds - using SpecificProcMapType = - std::multimap>; - SpecificProcMapType specificProcs_; - void AddSpecificProcs(const std::list &, ProcedureKind); - void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart); void ResolveNewSpecifics(); }; @@ -904,7 +913,7 @@ }; class DeclarationVisitor : public ArraySpecVisitor, - public virtual ScopeHandler { + public virtual GenericHandler { public: using ArraySpecVisitor::Post; using ScopeHandler::Post; @@ -3309,35 +3318,32 @@ void InterfaceVisitor::AddSpecificProcs( const std::list &names, ProcedureKind kind) { - for (const auto &name : names) { - specificProcs_.emplace( - GetGenericInfo().symbol, std::make_pair(&name, kind)); + if (Symbol * symbol{GetGenericInfo().symbol}; + symbol && symbol->has()) { + for (const auto &name : names) { + specificsForGenericProcs_.emplace(symbol, std::make_pair(&name, kind)); + genericsForSpecificProcs_.emplace(name.source, symbol); + } } } // By now we should have seen all specific procedures referenced by name in // this generic interface. Resolve those names to symbols. -void InterfaceVisitor::ResolveSpecificsInGeneric( +void GenericHandler::ResolveSpecificsInGeneric( Symbol &generic, bool isEndOfSpecificationPart) { auto &details{generic.get()}; UnorderedSymbolSet symbolsSeen; for (const Symbol &symbol : details.specificProcs()) { symbolsSeen.insert(symbol.GetUltimate()); } - auto range{specificProcs_.equal_range(&generic)}; + auto range{specificsForGenericProcs_.equal_range(&generic)}; SpecificProcMapType retain; for (auto it{range.first}; it != range.second; ++it) { const parser::Name *name{it->second.first}; auto kind{it->second.second}; - const Symbol *symbol{FindSymbol(*name)}; - if (!isEndOfSpecificationPart && symbol && - &symbol->owner() != &generic.owner()) { - // Don't mistakenly use a name from the enclosing scope while there's - // still a chance that it could be overridden by a later declaration in - // this scope. - retain.emplace(&generic, std::make_pair(name, kind)); - continue; - } + const Symbol *symbol{isEndOfSpecificationPart + ? FindSymbol(*name) + : FindInScope(generic.owner(), *name)}; ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None}; const Symbol *specific{symbol}; const Symbol *ultimate{nullptr}; @@ -3400,8 +3406,15 @@ MakeOpName(generic.name())); } } - specificProcs_.erase(range.first, range.second); - specificProcs_.merge(std::move(retain)); + specificsForGenericProcs_.erase(range.first, range.second); + specificsForGenericProcs_.merge(std::move(retain)); +} + +void GenericHandler::DeclaredPossibleSpecificProc(Symbol &proc) { + auto range{genericsForSpecificProcs_.equal_range(proc.name())}; + for (auto iter{range.first}; iter != range.second; ++iter) { + ResolveSpecificsInGeneric(*iter->second, false); + } } void InterfaceVisitor::ResolveNewSpecifics() { @@ -4141,6 +4154,9 @@ } } } + if (inInterfaceBlock() && currScope().symbol()) { + DeclaredPossibleSpecificProc(*currScope().symbol()); + } PopScope(); } @@ -5477,6 +5493,7 @@ if (dtDetails) { dtDetails->add_component(symbol); } + DeclaredPossibleSpecificProc(symbol); } bool DeclarationVisitor::Pre(const parser::TypeBoundProcedurePart &) { diff --git a/flang/test/Semantics/symbol29.f90 b/flang/test/Semantics/symbol29.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/symbol29.f90 @@ -0,0 +1,62 @@ +! RUN: %python %S/test_symbols.py %s %flang_fc1 +! References to generic functions with forward-referenced specifics. +!DEF: /m Module +module m +contains + !DEF: /m/specific4 PUBLIC (Function) Subprogram INTEGER(4) + !DEF: /m/specific4/x INTENT(IN) ObjectEntity INTEGER(4) + integer function specific4(x) + !REF: /m/specific4/x + integer, intent(in) :: x(*) + end function + !DEF: /m/test PUBLIC (Subroutine) Subprogram + !DEF: /m/test/specific1 EXTERNAL (Function) Subprogram INTEGER(4) + subroutine test (specific1) + !DEF: /m/test/generic (Function) Generic + interface generic + !REF: /m/test/specific1 + procedure :: specific1 + !DEF: /m/test/specific2 EXTERNAL, PURE (Function) Subprogram INTEGER(4) + procedure :: specific2 + !DEF: /m/test/specific3 EXTERNAL (Function) Subprogram INTEGER(4) + procedure :: specific3 + !DEF: /m/test/specific4 EXTERNAL (Function) Subprogram INTEGER(4) + procedure :: specific4 + end interface + interface + !REF: /m/test/specific1 + !DEF: /m/test/specific1/x INTENT(IN) ObjectEntity INTEGER(4) + integer function specific1(x) + !REF: /m/test/specific1/x + integer, intent(in) :: x + end function + !REF: /m/test/specific2 + !DEF: /m/test/specific2/x INTENT(IN) ObjectEntity INTEGER(4) + !DEF: /m/test/specific2/y INTENT(IN) ObjectEntity INTEGER(4) + pure integer function specific2(x, y) + !REF: /m/test/specific2/x + !REF: /m/test/specific2/y + integer, intent(in) :: x, y + end function + !REF: /m/test/specific3 + !DEF: /m/test/specific3/x INTENT(IN) ObjectEntity INTEGER(4) + !DEF: /m/test/specific3/y INTENT(IN) ObjectEntity INTEGER(4) + integer function specific3(x, y) + !REF: /m/test/generic + import :: generic + !REF: /m/test/specific3/x + !REF: /m/test/specific3/y + !REF: /m/test/specific2 + integer, intent(in) :: x, y(generic(1, x)) + end function + !REF: /m/test/specific4 + !DEF: /m/test/specific4/x INTENT(IN) ObjectEntity INTEGER(4) + integer function specific4(x) + !REF: /m/test/specific4/x + integer, intent(in) :: x(:) + end function + end interface + !REF: /m/test/specific4 + print *, generic([1]) + end subroutine +end module