[flang-commits] [PATCH] D105464: [flang] Create HostAssocDetails symbols when needed for mis-parsed ArrayRef

[Jean Perier via Phabricator via flang-commits]

jeanPerier updated this revision to Diff 356729.
jeanPerier added a comment.

Fix typo in comment.


Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D105464/new/

https://reviews.llvm.org/D105464

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


Index: flang/test/Semantics/symbol03.f90
===================================================================
--- flang/test/Semantics/symbol03.f90
+++ flang/test/Semantics/symbol03.f90
@@ -23,3 +23,34 @@
   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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -920,6 +920,7 @@
   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 @@
   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 @@
         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 @@
   // 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;
     }
   }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D105464.356729.patch
Type: text/x-patch
Size: 3981 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20210706/d0dd1979/attachment-0001.bin>