From c2d4d6a1fde127316aae2fdd48b4322857987be3 Mon Sep 17 00:00:00 2001
From: Jean Perier <jperier@nvidia.com>
Date: Wed, 7 Jul 2021 10:06:43 +0200
Subject: [PATCH] [flang] Create HostAssocDetails symbols when needed for
 mis-parsed ArrayRef

Name resolution is always creating symbols with HostAssocDetails
for host variable names inside internal procedures. This helps lowering
identifying and dealing with such variables inside internal procedures.

However, the case where the variable appears in an ArrayRef mis-parsed
as a FunctionRef goes through a different name resolution path that did
not create such HostAssocDetails when needed. Pointer assignment RHS
are also skipping this path.

Add the logic to create HostAssocDetails for host symbols inisde internal
procedures that appear in mis-parsed ArrayRef or in pointer assignment RHS.

Differential Revision: https://reviews.llvm.org/D105464
---
 flang/lib/Semantics/resolve-names.cpp | 26 ++++++++++++++++------
 flang/test/Semantics/symbol03.f90     | 31 +++++++++++++++++++++++++++
 2 files changed, 50 insertions(+), 7 deletions(-)

diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index e3baae275aa1a2..7fa3dee3fd2111 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -920,6 +920,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
   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 @@ 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 &);
   void Initialization(const parser::Name &, const parser::Initialization &,
       bool inComponentDecl);
@@ -6186,13 +6186,19 @@ void ResolveNamesVisitor::HandleProcedureName(
         symbol->attrs().test(Attr::ABSTRACT)) {
       Say(name, "Abstract interface '%s' may not be called"_err_en_US);
     } else if (IsProcedure(*symbol) || symbol->has<DerivedTypeDetails>() ||
-        symbol->has<ObjectEntityDetails>() ||
         symbol->has<AssocEntityDetails>()) {
-      // 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<ObjectEntityDetails>()) {
+      // 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 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
   // Resolve unrestricted specific intrinsic procedures as in "p => cos".
   if (const parser::Name * name{parser::Unwrap<parser::Name>(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<ObjectEntityDetails>() && IsUplevelReference(*symbol)) {
+        MakeHostAssocSymbol(*name, *symbol);
+      }
       return false;
     }
   }
diff --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90
index 93c56d889c0cf7..eb7d4b303ea410 100644
--- a/flang/test/Semantics/symbol03.f90
+++ b/flang/test/Semantics/symbol03.f90
@@ -23,3 +23,34 @@ subroutine s2
   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