[flang] More error checking for ASSOCIATED()

[klausler]

Summary

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.

[clementval]

LGTM

flang/lib/Evaluate/intrinsics.cpp

if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
                   targetName = targetProcRef->proc().GetName() + "()";
                   isCall = true;
                 }
               } else if (targetProcDesignator) {
                 targetProc = characteristics::Procedure::Characterize(
                     *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);
                 }
                 targetName = targetSymbol->name().ToString();
               }
               if (IsProcedure(*pointerSymbol)) {
                 pointerProc = characteristics::Procedure::Characterize(
                     *pointerSymbol, context);
if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
                 if (!GetLastTarget(symbols)) {
                   parser::Message *msg{context.messages().Say(
                       targetArg->sourceLocation(),
                       "TARGET= argument '%s' must have either the POINTER or the TARGET attribute"_err_en_US,
                       targetExpr->AsFortran())};
                   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()}) {
                     ok = pointerType->IsTkCompatibleWith(*targetType);
                   }
                 }
               }
             }

flang/test/Semantics/associated.f90

subroutine test()
     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: 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
subroutine test()
     implicitProcPointer => subr ! OK for an implicit point to point to an explicit proc
     lvar = associated(implicitProcPointer, subr) ! OK
     !WARNING: Procedure pointer 'implicitprocpointer' with implicit interface may not be associated with procedure designator 'subrcannotbecalledfromimplicit' with explicit interface that cannot be called via an implicit interface
     lvar = associated(implicitProcPointer, subrCannotBeCalledFromImplicit)
     !ERROR: Procedure pointer 'cannotbecalledfromimplicitpointer' with explicit interface that cannot be called via an implicit interface cannot be associated with procedure designator with an implicit interface
     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