[flang-commits] [flang] c2d4d6a - [flang] Create HostAssocDetails symbols when needed for mis-parsed ArrayRef

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2021-07-07T10:07:19+02:00
New Revision: c2d4d6a1fde127316aae2fdd48b4322857987be3

URL: https://github.com/llvm/llvm-project/commit/c2d4d6a1fde127316aae2fdd48b4322857987be3
DIFF: https://github.com/llvm/llvm-project/commit/c2d4d6a1fde127316aae2fdd48b4322857987be3.diff

LOG: [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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/symbol03.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index e3baae275aa1a..7fa3dee3fd211 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 93c56d889c0cf..eb7d4b303ea41 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