[flang] Create HostAssoc symbols for uplevel references

[tskeith]

Summary

To make it easier for lowering to identify which symbols from the host
are captured by internal subprograms, create HostAssocDetails for them.

In particular, if a symbol is referenced and it is contained in a
subprogram or main program that is not the same as the containing
program unit of the reference, a HostAssocDetails symbol is created
in the current scope.

[PeteSteinfeld]

All builds, tests, and looks good.

[jeanPerier]

Looks good to me, thanks for implementing this.

flang/lib/Semantics/resolve-names.cpp

ParamValue GetParamValue(
       const parser::TypeParamValue &, common::TypeParamAttr attr);
   Symbol &MakeCommonBlockSymbol(const parser::Name &);
   void CheckCommonBlockDerivedType(const SourceName &, const Symbol &);
   std::optional<MessageFixedText> CheckSaveAttr(const Symbol &);
   Attrs HandleSaveName(const SourceName &, Attrs);
   void AddSaveName(std::set<SourceName> &, const SourceName &);
   void SetSaveAttr(Symbol &);
   bool HandleUnrestrictedSpecificIntrinsicFunction(const parser::Name &);
+  bool IsUplevelReference(const Symbol &);
   const parser::Name *FindComponent(const parser::Name *, const parser::Name &);
   bool CheckInitialDataTarget(const Symbol &, const SomeExpr &, SourceName);
   void CheckInitialProcTarget(const Symbol &, const parser::Name &, SourceName);
   void Initialization(const parser::Name &, const parser::Initialization &,
       bool inComponentDecl);
   bool PassesLocalityChecks(const parser::Name &name, Symbol &symbol);
 
   // Declare an object or procedure entity.

 
 // If implicit types are allowed, ensure name is in the symbol table.
 // Otherwise, report an error if it hasn't been declared.
 const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
   if (Symbol * symbol{FindSymbol(name)}) {
     if (CheckUseError(name)) {
       return nullptr; // reported an error
     }
-    if (IsDummy(*symbol) ||
+    if (IsUplevelReference(*symbol)) {
+      name.symbol = nullptr;
+      MakeSymbol(name, HostAssocDetails{*symbol});
+    } else if (IsDummy(*symbol) ||
         (!symbol->GetType() && FindCommonBlockContaining(*symbol))) {
       ConvertToObjectEntity(*symbol);
       ApplyImplicitRules(*symbol);
     }
     return &name;
   }
   if (isImplicitNoneType()) {
     Say(name, "No explicit type declared for '%s'"_err_en_US);
     return nullptr;
   }
   // Create the symbol then ensure it is accessible
   MakeSymbol(InclusiveScope(), name.source, Attrs{});
   auto *symbol{FindSymbol(name)};
   if (!symbol) {
     Say(name,
         "'%s' from host scoping unit is not accessible due to IMPORT"_err_en_US);
     return nullptr;
   }
   ConvertToObjectEntity(*symbol);
   ApplyImplicitRules(*symbol);
   return &name;
 }
 
+bool DeclarationVisitor::IsUplevelReference(const Symbol &symbol) {
+  const Scope *symbolUnit{FindProgramUnitContaining(symbol)};
+  if (symbolUnit == FindProgramUnitContaining(currScope())) {
+    return false;
+  } else {
+    Scope::Kind kind{DEREF(symbolUnit).kind()};
+    return kind == Scope::Kind::Subprogram || kind == Scope::Kind::MainProgram;
+  }
+}
+
 // base is a part-ref of a derived type; find the named component in its type.
 // Also handles intrinsic type parameter inquiries (%kind, %len) and
 // COMPLEX component references (%re, %im).
 const parser::Name *DeclarationVisitor::FindComponent(
     const parser::Name *base, const parser::Name &component) {
   if (!base || !base->symbol) {
     return nullptr;
   }

flang/lib/Semantics/tools.cpp

return maybeAncestor && !maybeDescendent.IsGlobal() &&
       FindScopeContaining(maybeDescendent.parent(),
           [&](const Scope &scope) { return &scope == maybeAncestor; });
 }
 
 bool DoesScopeContain(const Scope *maybeAncestor, const Symbol &symbol) {
   return DoesScopeContain(maybeAncestor, symbol.owner());
 }
 
+static const Symbol &FollowHostAssoc(const Symbol &symbol) {
+  for (const Symbol *s{&symbol};;) {
+    const auto *details{s->detailsIf<HostAssocDetails>()};
+    if (!details) {
+      return *s;
+    }
+    s = &details->symbol();
+  }
+}
+
 bool IsHostAssociated(const Symbol &symbol, const Scope &scope) {
   const Scope *subprogram{FindProgramUnitContaining(scope)};
   return subprogram &&
-      DoesScopeContain(FindProgramUnitContaining(symbol), *subprogram);
+      DoesScopeContain(
+          FindProgramUnitContaining(FollowHostAssoc(symbol)), *subprogram);
 }
 
 bool IsInStmtFunction(const Symbol &symbol) {
   if (const Symbol * function{symbol.owner().symbol()}) {
     return IsStmtFunction(*function);
   }
   return false;
 }

flang/test/Semantics/symbol02.f90

contains
    import, only: x, y, t, s
    !REF: /m/t
    !DEF: /m/s/s2/z ObjectEntity TYPE(t)
    type(t) :: z
    !REF: /m/s/s2/z
    !REF: /m/x
    z = x
    !REF: /m/s/s2/z
-   !REF: /m/s/y
+   !DEF: /m/s/s2/y HostAssoc TYPE(t)
    z = y
    !REF: /m/s/s
    call s
   end subroutine
  end subroutine
 end module

flang/test/Semantics/symbol03.f90

 ! RUN: %S/test_symbols.sh %s %t %f18
 ! Test host association in internal subroutine of main program.
 
 !DEF: /main MainProgram
 program main
  !DEF: /main/x ObjectEntity INTEGER(4)
  integer x
  !DEF: /main/s (Subroutine) Subprogram
  call s
 contains
  !REF: /main/s
  subroutine s
   !DEF: /main/s/y (Implicit) ObjectEntity REAL(4)
-  !REF: /main/x
+  !DEF: /main/s/x HostAssoc INTEGER(4)
   y = x
+ contains
+  !DEF: /main/s/s2 (Subroutine) Subprogram
+  subroutine s2
+   !DEF: /main/s/s2/z (Implicit) ObjectEntity REAL(4)
+   !DEF: /main/s/s2/x HostAssoc INTEGER(4)
+   z = x
+  end subroutine
  end subroutine
 end program

flang/test/Semantics/symbol05.f90

block
   !DEF: /s2/x (Implicit) ObjectEntity INTEGER(4)
   x = 1
   !DEF: /s2/y (Implicit) ObjectEntity REAL(4)
   y = 2
  end block
 contains
  !DEF: /s2/s (Subroutine) Subprogram
  subroutine s
-  !REF: /s2/x
+  !DEF: /s2/s/x HostAssoc INTEGER(4)
   x = 1
   !DEF: /s2/s/w (Implicit) ObjectEntity INTEGER(4)
   w = 1
  end subroutine
 end subroutine
 
 !DEF: /s3 (Subroutine) Subprogram
 subroutine s3