[flang-commits] [flang] f2f6190 - [flang] Always create HostAssocDetails for host object symbols with UseDetails

[Jean Perier via flang-commits]

Author: Jean Perier
Date: 2021-08-10T12:38:19+02:00
New Revision: f2f6190960ee77e132b75ea2d92ce362e9a74b9a

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

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

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).

Differential Revision: https://reviews.llvm.org/D107759

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 bdc4082fe58bb..40ca1c014f592 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -6182,6 +6182,7 @@ void ResolveNamesVisitor::HandleProcedureName(
   } 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 @@ void ResolveNamesVisitor::HandleProcedureName(
       // 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 @@ bool ResolveNamesVisitor::Pre(const parser::PointerAssignmentStmt &x) {
       // 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;

diff  --git a/flang/test/Semantics/symbol03.f90 b/flang/test/Semantics/symbol03.f90
index d132747ca8c9e..a6b4b0bd15937 100644
--- a/flang/test/Semantics/symbol03.f90
+++ b/flang/test/Semantics/symbol03.f90
@@ -53,3 +53,49 @@ subroutine s1
   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