[flang-commits] [flang] e86e2ab - [flang] More error checking for ASSOCIATED()

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-12-03T17:42:43-08:00
New Revision: e86e2ab97300528e7a0fb4b63b87993fa054289e

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

LOG: [flang] More error checking for ASSOCIATED()

The TARGET= argument of the ASSOCIATED() intrinsic function must be a valid
pointer assignment statement target.  Ensure that it does not contain a vector
subscript or any coindexing, either of which would imply a data copy into
temporary storage.

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

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 4fbb11e31b71..948c72af1051 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2631,8 +2631,8 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
                     *targetProcDesignator, context);
                 targetName = targetProcDesignator->GetName();
               } else if (targetSymbol) {
-                // proc that's not a call
                 if (IsProcedure(*targetSymbol)) {
+                  // proc that's not a call
                   targetProc = characteristics::Procedure::Characterize(
                       *targetSymbol, context);
                 }
@@ -2693,6 +2693,11 @@ static bool CheckAssociated(SpecificCall &call, FoldingContext &context) {
                   for (SymbolRef ref : symbols) {
                     msg = AttachDeclaration(msg, *ref);
                   }
+                } else if (HasVectorSubscript(*targetExpr) ||
+                    ExtractCoarrayRef(*targetExpr)) {
+                  context.messages().Say(targetArg->sourceLocation(),
+                      "TARGET= argument '%s' may not have a vector subscript or coindexing"_err_en_US,
+                      targetExpr->AsFortran());
                 }
                 if (const auto pointerType{pointerArg->GetType()}) {
                   if (const auto targetType{targetArg->GetType()}) {

diff  --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index 6774a6447bfc..6cb7a9386f79 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -73,6 +73,9 @@ subroutine test()
     type(t1), target :: t1xtarget
     type(t2) :: t2x
     type(t2), target :: t2xtarget
+    integer, target :: targetIntArr(2)
+    integer, target :: targetIntCoarray[*]
+    integer, pointer :: intPointerArr(:)
 
     !ERROR: missing mandatory 'pointer=' argument
     lVar = associated()
@@ -177,5 +180,9 @@ subroutine test()
     cannotBeCalledfromImplicitPointer => externalProc
     !WARNING: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
     lvar = associated(cannotBeCalledfromImplicitPointer, externalProc)
+    !ERROR: TARGET= argument 'targetintarr([INTEGER(8)::2_8,1_8])' may not have a vector subscript or coindexing
+    lvar = associated(intPointerArr, targetIntArr([2,1]))
+    !ERROR: TARGET= argument 'targetintcoarray[1_8]' may not have a vector subscript or coindexing
+    lvar = associated(intPointerVar1, targetIntCoarray[1])
   end subroutine test
 end subroutine assoc