[flang-commits] [flang] 8eb2206 - [flang] Accept an assumed-rank array as operand of ASSOCIATED()

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-21T09:47:14-07:00
New Revision: 8eb2206197a31290e33a0e4a4a5d0010c176e31e

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

LOG: [flang] Accept an assumed-rank array as operand of ASSOCIATED()

The ASSOCIATED() intrinsic was mistakenly defined in the intrinsic
function table as requiring operands of known rank, which unintentionally
prevented assumed-rank dummy arguments from being tested.

Fixes llvm-test-suite/Fortran/gfortran/regression/pr88932.f90.

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

Added: 
    

Modified: 
    flang/lib/Evaluate/intrinsics.cpp
    flang/test/Semantics/associated.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index c6f32c08824788..aa0d349ad5e88f 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -326,7 +326,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
     {"asind", {{"x", SameFloating}}, SameFloating},
     {"asinh", {{"x", SameFloating}}, SameFloating},
     {"associated",
-        {{"pointer", AnyPointer, Rank::known, Optionality::required,
+        {{"pointer", AnyPointer, Rank::anyOrAssumedRank, Optionality::required,
              common::Intent::In, {ArgFlag::canBeNull}},
             {"target", Addressable, Rank::known, Optionality::optional,
                 common::Intent::In, {ArgFlag::canBeNull}}},
@@ -1966,15 +1966,22 @@ std::optional<SpecificCall> IntrinsicInterface::Match(
         if (!knownArg) {
           knownArg = arg;
         }
-        argOk = rank == knownArg->Rank();
+        argOk = !isAssumedRank && rank == knownArg->Rank();
         break;
       case Rank::anyOrAssumedRank:
       case Rank::arrayOrAssumedRank:
+        if (isAssumedRank) {
+          argOk = true;
+          break;
+        }
         if (d.rank == Rank::arrayOrAssumedRank && rank == 0) {
           argOk = false;
           break;
         }
-        if (!dimArg && rank > 0 && !isAssumedRank &&
+        if (!knownArg) {
+          knownArg = arg;
+        }
+        if (!dimArg && rank > 0 &&
             (std::strcmp(name, "shape") == 0 ||
                 std::strcmp(name, "size") == 0 ||
                 std::strcmp(name, "ubound") == 0)) {

diff  --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 94b07f718ab644..73a41088c7ccb1 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -48,11 +48,13 @@ subroutine subrCannotBeCalledfromImplicit(i)
     integer :: i(:)
   end subroutine subrCannotBeCalledfromImplicit
 
-  subroutine test()
+  subroutine test(assumedRank)
+    real, pointer, intent(in out) :: assumedRank(..)
     integer :: intVar
     integer, target :: targetIntVar1
     integer(kind=2), target :: targetIntVar2
-    real, target :: targetRealVar
+    real, target :: targetRealVar, targetRealMat(2,2)
+    real, pointer :: realScalarPtr, realVecPtr(:), realMatPtr(:,:)
     integer, pointer :: intPointerVar1
     integer, pointer :: intPointerVar2
     integer, allocatable :: intAllocVar
@@ -77,6 +79,20 @@ subroutine test()
     integer, target :: targetIntCoarray[*]
     integer, pointer :: intPointerArr(:)
 
+    !ERROR: Assumed-rank array cannot be forwarded to 'target=' argument
+    lvar = associated(assumedRank, assumedRank)
+    lvar = associated(assumedRank, targetRealVar) ! ok
+    lvar = associated(assumedRank, targetRealMat) ! ok
+    lvar = associated(realScalarPtr, targetRealVar) ! ok
+    !ERROR: 'target=' argument has unacceptable rank 0
+    lvar = associated(realVecPtr, targetRealVar)
+    !ERROR: 'target=' argument has unacceptable rank 0
+    lvar = associated(realMatPtr, targetRealVar)
+    !ERROR: 'target=' argument has unacceptable rank 2
+    lvar = associated(realScalarPtr, targetRealMat)
+    !ERROR: 'target=' argument has unacceptable rank 2
+    lvar = associated(realVecPtr, targetRealMat)
+    lvar = associated(realMatPtr, targetRealMat) ! ok
     !ERROR: missing mandatory 'pointer=' argument
     lVar = associated()
     !ERROR: MOLD= argument to NULL() must be a pointer or allocatable