From 38272f45fed3f2233d54ff1495a4433f87215667 Mon Sep 17 00:00:00 2001
From: Tim Keith <tkeith@nvidia.com>
Date: Thu, 30 Jul 2020 07:12:24 -0700
Subject: [PATCH] [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 | 16 +++++++++++++++-
 flang/lib/Semantics/tools.cpp         | 13 ++++++++++++-
 flang/test/Semantics/symbol02.f90     |  2 +-
 flang/test/Semantics/symbol03.f90     |  9 ++++++++-
 flang/test/Semantics/symbol05.f90     |  2 +-
 5 files changed, 37 insertions(+), 5 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 50ea735d81d5e..744eee19ba43c 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/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).
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 2607011333964..d5ef9c76aa34c 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/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) {
diff --git a/flang/test/Semantics/symbol02.f90 b/flang/test/Semantics/symbol02.f90
index 4d73edd660446..add42939e4647 100644
--- a/flang/test/Semantics/symbol02.f90
+++ b/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
diff --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90
index 2f3620284a833..a398d8db40b0d 100644
--- a/flang/test/Semantics/symbol03.f90
+++ b/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
diff --git a/flang/test/Semantics/symbol05.f90 b/flang/test/Semantics/symbol05.f90
index 0c36384a6c4eb..03f6fbbd989e3 100644
--- a/flang/test/Semantics/symbol05.f90
+++ b/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