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

[klausler]

Summary

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.

[vzakhari]

LGTM. Thank you!

flang/lib/Evaluate/intrinsics.cpp

static const IntrinsicInterface genericIntrinsicFunction[]{
         Rank::elemental, IntrinsicClass::inquiryFunction},
     {"anint", {{"a", SameReal}, MatchingDefaultKIND}, KINDReal},
     {"any", {{"mask", SameLogical, Rank::array}, OptionalDIM}, SameLogical,
         Rank::dimReduced, IntrinsicClass::transformationalFunction},
     {"asin", {{"x", SameFloating}}, SameFloating},
     {"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}}},
         DefaultLogical, Rank::elemental, IntrinsicClass::inquiryFunction},
     {"atan", {{"x", SameFloating}}, SameFloating},
     {"atand", {{"x", SameFloating}}, SameFloating},
     {"atan", {{"y", OperandReal}, {"x", OperandReal}}, OperandReal},
     {"atand", {{"y", OperandReal}, {"x", OperandReal}}, OperandReal},
if (const ActualArgument *arg{actualForDummy[j]}) {
               d.keyword, name);
           return std::nullopt;
         }
         break;
       case Rank::known:
         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)) {
           // Check for a whole assumed-size array argument.
           // These are disallowed for SHAPE, and require DIM= for
           // SIZE and UBOUND.
           // (A previous error message for UBOUND will take precedence
           // over this one, as this error is caught by the second entry

flang/test/Semantics/associated.f90

subroutine assoc()
   subroutine subr(i)
     integer :: i
   end subroutine subr
 
   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
     procedure(intFunc) :: intProc
     procedure(intFunc), pointer :: intprocPointer1
     procedure(intFunc), pointer :: intprocPointer2
     procedure(realFunc) :: realProc
     procedure(realFunc), pointer :: realprocPointer1
     procedure(pureFunc), pointer :: pureFuncPointer
     procedure(elementalFunc) :: elementalProc
     external :: externalProc
     procedure(subrInt) :: subProc
     procedure(subrInt), pointer :: subProcPointer
     procedure(), pointer :: implicitProcPointer
     procedure(subrCannotBeCalledfromImplicit), pointer :: cannotBeCalledfromImplicitPointer
     logical :: lVar
     type(t1) :: t1x
     type(t1), target :: t1xtarget
     type(t2) :: t2x
     type(t2), target :: t2xtarget
     integer, target :: targetIntArr(2)
     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
     lVar = associated(null(intVar))
     lVar = associated(null(intAllocVar)) !OK
     lVar = associated(null()) !OK
     lVar = associated(null(intPointerVar1)) !OK
     !PORTABILITY: POINTER= argument of ASSOCIATED() would not be a valid left-hand side of a pointer assignment statement