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 @@ -920,6 +920,7 @@ const parser::Name *ResolveName(const parser::Name &); bool PassesSharedLocalityChecks(const parser::Name &name, Symbol &symbol); Symbol *NoteInterfaceName(const parser::Name &); + bool IsUplevelReference(const Symbol &); private: // The attribute corresponding to the statement containing an ObjectDecl @@ -971,7 +972,6 @@ void AddSaveName(std::set &, const SourceName &); void SetSaveAttr(Symbol &); bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &); - bool IsUplevelReference(const Symbol &); const parser::Name *FindComponent(const parser::Name *, const parser::Name &); void Initialization(const parser::Name &, const parser::Initialization &, bool inComponentDecl); @@ -6186,13 +6186,19 @@ symbol->attrs().test(Attr::ABSTRACT)) { Say(name, "Abstract interface '%s' may not be called"_err_en_US); } else if (IsProcedure(*symbol) || symbol->has() || - symbol->has() || symbol->has()) { - // Symbols with DerivedTypeDetails, ObjectEntityDetails and - // AssocEntityDetails are accepted here as procedure-designators because - // this means the related FunctionReference are mis-parsed structure - // constructors or array references that will be fixed later when - // analyzing expressions. + // Symbols with DerivedTypeDetails and AssocEntityDetails are accepted + // here as procedure-designators because this means the related + // FunctionReference are mis-parsed structure constructors or array + // references that will be fixed later when analyzing expressions. + } else if (symbol->has()) { + // Symbols with ObjectEntityDetails are also accepted because this can be + // a mis-parsed array references that will be fixed later. Ensure that if + // this is a symbol from a host procedure, a symbol with HostAssocDetails + // is created for the current scope. + if (IsUplevelReference(*symbol)) { + MakeHostAssocSymbol(name, *symbol); + } } else if (symbol->test(Symbol::Flag::Implicit)) { Say(name, "Use of '%s' as a procedure conflicts with its implicit definition"_err_en_US); @@ -6589,6 +6595,12 @@ // Resolve unrestricted specific intrinsic procedures as in "p => cos". if (const parser::Name * name{parser::Unwrap(expr)}) { if (NameIsKnownOrIntrinsic(*name)) { + // If the name is known because it is an object entity from a host + // procedure, create a host associated symbol. + if (Symbol * symbol{name->symbol}; symbol && + symbol->has() && IsUplevelReference(*symbol)) { + MakeHostAssocSymbol(*name, *symbol); + } return false; } } diff --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90 --- a/flang/test/Semantics/symbol03.f90 +++ b/flang/test/Semantics/symbol03.f90 @@ -23,3 +23,34 @@ end subroutine end subroutine end program + +!DEF: /s (Subroutine) Subprogram +subroutine s + !DEF: /s/x ObjectEntity REAL(4) + real x(100, 100) + !DEF: /s/s1 (Subroutine) Subprogram + call s1 +contains + !REF: /s/s1 + subroutine s1 + !DEF: /s/s1/x HostAssoc REAL(4) + print *, x(10, 10) + end subroutine +end subroutine + +!DEF: /sb (Subroutine) Subprogram +subroutine sb + !DEF: /sb/x TARGET ObjectEntity REAL(4) + real, target :: x + !DEF: /sb/s1 (Subroutine) Subprogram + call s1 +contains + !REF: /sb/s1 + subroutine s1 + !DEF: /sb/s1/p POINTER ObjectEntity REAL(4) + real, pointer :: p + !REF: /sb/s1/p + !DEF: /sb/s1/x TARGET HostAssoc REAL(4) + p => x + end subroutine +end subroutine