[flang] Create HostAssoc symbols for uplevel references

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.

Differential Revision: https://reviews.llvm.org/D84889

flang/lib/Semantics/resolve-names.cpp

@@ -909,6 +909,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   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);
@@ -5429,7 +5430,10 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &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);
@@ -5453,6 +5457,16 @@ const parser::Name *DeclarationVisitor::ResolveName(const parser::Name &name) {
   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).

flang/lib/Semantics/tools.cpp

@@ -179,10 +179,21 @@ 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) {

flang/test/Semantics/symbol02.f90

@@ -44,7 +44,7 @@ subroutine s2
    !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

flang/test/Semantics/symbol03.f90

@@ -11,7 +11,14 @@ program main
  !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

@@ -33,7 +33,7 @@ subroutine s2
 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