[flang] Refine pointer/target test for ASSOCIATED intrinsic

[klausler]

Summary

The second argument to the ASSOCIATED intrinsic must be a valid pointer
or target. The test for this property only checked the last symbol
in a data-reference, but any symbol in the reference with the
POINTER or TARGET attribute will do.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/intrinsics.cpp

if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
                 // object pointer and procedure target
                 AttachDeclaration(
                     context.messages().Say(
                         "POINTER= argument '%s' is an object pointer "
                         "but the TARGET= argument '%s' is a "
                         "procedure designator"_err_en_US,
                         pointerSymbol->name(), targetName),
                     *pointerSymbol);
-              } else {
+              } else if (targetSymbol) {
                 // object pointer and target
-                if (const Symbol * targetSymbol{GetLastSymbol(*targetExpr)}) {
-                  if (!(targetSymbol->attrs().test(semantics::Attr::POINTER) ||
-                          targetSymbol->attrs().test(
-                              semantics::Attr::TARGET))) {
-                    AttachDeclaration(
-                        context.messages().Say(
-                            "TARGET= argument '%s' must have either "
-                            "the POINTER or the TARGET "
-                            "attribute"_err_en_US,
-                            targetName),
-                        *targetSymbol);
+                SymbolVector symbols{GetSymbolVector(*targetExpr)};
+                CHECK(!symbols.empty());
+                if (!GetLastTarget(symbols)) {
+                  parser::Message *msg{context.messages().Say(
+                      "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);
                   }
                 }
-
                 if (const auto pointerType{pointerArg->GetType()}) {
                   if (const auto targetType{targetArg->GetType()}) {
                     ok = pointerType->IsTkCompatibleWith(*targetType);
                   }
                 }
               }
             }
           }

flang/test/Semantics/associated.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Tests for the ASSOCIATED() and NULL() intrinsics
 subroutine assoc()
 
   abstract interface
     subroutine subrInt(i)
       integer :: i
     end subroutine subrInt
 
     integer function abstractIntFunc(x)
       integer, intent(in) :: x
     end function
   end interface
 
+  type :: t1
+    integer :: n
+  end type t1
+  type :: t2
+    type(t1) :: t1arr(2)
+    type(t1), pointer :: t1ptr(:)
+  end type t2
+
   contains
   integer function intFunc(x)
     integer, intent(in) :: x
     intFunc = x
   end function
 
   real function realFunc(x)
     real, intent(in) :: x
subroutine test()
     procedure(realFunc), pointer :: realprocPointer1
     procedure(pureFunc), pointer :: pureFuncPointer
     procedure(elementalFunc) :: elementalProc
     external :: externalProc
     procedure(subrInt) :: subProc
     procedure(subrInt), pointer :: subProcPointer
     procedure(), pointer :: implicitProcPointer
     logical :: lVar
+    type(t1) :: t1x
+    type(t1), target :: t1xtarget
+    type(t2) :: t2x
+    type(t2), target :: t2xtarget
 
     !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()
     lVar = associated(intPointerVar1, targetIntVar2)
     lVar = associated(intPointerVar1) !OK
     lVar = associated(intPointerVar1, intPointerVar2) !OK
     !ERROR: In assignment to object pointer 'intpointervar1', the target 'intvar' is not an object with POINTER or TARGET attributes
     intPointerVar1 => intVar
     !ERROR: TARGET= argument 'intvar' must have either the POINTER or the TARGET attribute
     lVar = associated(intPointerVar1, intVar)
 
+    !ERROR: TARGET= argument 't1x%n' must have either the POINTER or the TARGET attribute
+    lVar = associated(intPointerVar1, t1x%n)
+    lVar = associated(intPointerVar1, t1xtarget%n) ! ok
+    !ERROR: TARGET= argument 't2x%t1arr(1_8)%n' must have either the POINTER or the TARGET attribute
+    lVar = associated(intPointerVar1, t2x%t1arr(1)%n)
+    lVar = associated(intPointerVar1, t2x%t1ptr(1)%n) ! ok
+    lVar = associated(intPointerVar1, t2xtarget%t1arr(1)%n) ! ok
+    lVar = associated(intPointerVar1, t2xtarget%t1ptr(1)%n) ! ok
+
     ! Procedure pointer tests
     intprocPointer1 => intProc !OK
     lVar = associated(intprocPointer1, intProc) !OK
     intprocPointer1 => intProcPointer2 !OK
     lVar = associated(intprocPointer1, intProcPointer2) !OK
     intProcPointer1  => null(intProcPointer2) ! ok
     lvar = associated(intProcPointer1, null(intProcPointer2)) ! ok
     intProcPointer1 => null() ! ok