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 @@ -6182,6 +6182,7 @@ } else if (CheckUseError(name)) { // error was reported } else { + auto &nonUltimateSymbol = *symbol; symbol = &Resolve(name, symbol)->GetUltimate(); bool convertedToProcEntity{ConvertToProcEntity(*symbol)}; if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) && @@ -6206,8 +6207,10 @@ // 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); + // Operate on non ultimate symbol so that HostAssocDetails are also + // created for symbols used associated in the host procedure. + if (IsUplevelReference(nonUltimateSymbol)) { + MakeHostAssocSymbol(name, nonUltimateSymbol); } } else if (symbol->test(Symbol::Flag::Implicit)) { Say(name, @@ -6608,7 +6611,8 @@ // 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)) { + symbol->GetUltimate().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 @@ -53,3 +53,49 @@ p => x end subroutine end subroutine + +! Test host associated symbols are also created for symbols that are use +! associated in the host. + +!DEF: /m1 Module +module m1 + !DEF: /m1/x PUBLIC ObjectEntity REAL(4) + real x(100,100) + !DEF: /m1/x_target PUBLIC, TARGET ObjectEntity REAL(4) + real, target :: x_target +end module + +!DEF: /s_use (Subroutine) Subprogram +subroutine s_use + !REF: /m1 + use :: m1 + !DEF: /s_use/x Use REAL(4) + print *, x + !DEF: /s_use/s1 (Subroutine) Subprogram + call s1 +contains + !REF: /s_use/s1 + subroutine s1 + !DEF: /s_use/s1/x HostAssoc REAL(4) + print *, x(10,10) + end subroutine +end subroutine + +!DEF: /sb_use (Subroutine) Subprogram +subroutine sb_use + !REF: /m1 + use :: m1 + !DEF: /sb_use/x_target TARGET Use REAL(4) + print *, x_target + !DEF: /sb_use/s1 (Subroutine) Subprogram + call s1 +contains + !REF: /sb_use/s1 + subroutine s1 + !DEF: /sb_use/s1/p POINTER ObjectEntity REAL(4) + real, pointer :: p + !REF: /sb_use/s1/p + !DEF: /sb_use/s1/x_target TARGET HostAssoc REAL(4) + p => x_target + end subroutine +end subroutine