[PATCH] D107759: [flang] Always create HostAssocDetails for host object symbols with UseDetails

[Jean Perier via Phabricator via llvm-commits]

jeanPerier created this revision.
jeanPerier added reviewers: klausler, PeteSteinfeld.
jeanPerier added a project: Flang.
Herald added a subscriber: jdoerfert.
jeanPerier requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

https://reviews.llvm.org/D105464 did not correctly cover the case
where the symbol from the host procedure is use associated. Outside
of the mis-parsed ArrayRef case, flang was also creating a symbol with
HostAssociated details inside the internal procedure (pointing to the
use associated symbol in the host). That is what lowering expects.
This patch ensures the same logic is applied in the mis-parsed array-ref name
resolution (and the pointer target name resolution).


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D107759

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
@@ -54,3 +54,49 @@
   p => x
  end subroutine
 end subroutine
+
+! Test host associated symbols are also created for symbols that are use
+! associated in the host.
+
+!DEF: /m1 Module
+module m1
+ !DEF: /m1/x PUBLIC ObjectEntity REAL(4)
+ real x(100,100)
+ !DEF: /m1/x_target PUBLIC, TARGET ObjectEntity REAL(4)
+ real, target :: x_target
+end module
+
+!DEF: /s_use (Subroutine) Subprogram
+subroutine s_use
+ !REF: /m1
+ use :: m1
+ !DEF: /s_use/x Use REAL(4)
+ print *, x
+ !DEF: /s_use/s1 (Subroutine) Subprogram
+ call s1
+contains
+ !REF: /s_use/s1
+ subroutine s1
+  !DEF: /s_use/s1/x HostAssoc REAL(4)
+  print *, x(10,10)
+ end subroutine
+end subroutine
+
+!DEF: /sb_use (Subroutine) Subprogram
+subroutine sb_use
+ !REF: /m1
+ use :: m1
+ !DEF: /sb_use/x_target TARGET Use REAL(4)
+ print *, x_target
+ !DEF: /sb_use/s1 (Subroutine) Subprogram
+ call s1
+contains
+ !REF: /sb_use/s1
+ subroutine s1
+  !DEF: /sb_use/s1/p POINTER ObjectEntity REAL(4)
+  real, pointer :: p
+  !REF: /sb_use/s1/p
+  !DEF: /sb_use/s1/x_target TARGET HostAssoc REAL(4)
+  p => x_target
+ end subroutine
+end subroutine
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -6182,6 +6182,7 @@
   } else if (CheckUseError(name)) {
     // error was reported
   } else {
+    auto &nonUltimateSymbol = *symbol;
     symbol = &Resolve(name, symbol)->GetUltimate();
     bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
     if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
@@ -6206,8 +6207,10 @@
       // 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);
+      // Operate on non ultimate symbol so that HostAssocDetails are also
+      // created for symbols used associated in the host procedure.
+      if (IsUplevelReference(nonUltimateSymbol)) {
+        MakeHostAssocSymbol(name, nonUltimateSymbol);
       }
     } else if (symbol->test(Symbol::Flag::Implicit)) {
       Say(name,
@@ -6608,7 +6611,8 @@
       // 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)) {
+          symbol->GetUltimate().has<ObjectEntityDetails>() &&
+          IsUplevelReference(*symbol)) {
         MakeHostAssocSymbol(*name, *symbol);
       }
       return false;


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D107759.365155.patch
Type: text/x-patch
Size: 2933 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210809/f3a1945c/attachment.bin>