[flang] Another validity of the TARGET= argument of ASSOCIATED() for objects

[PeteSteinfeld]

Summary

In my previous implementation of the semantic checks for ASSOCIATED(), I
had neglected to check the TARGET= argument for objects to ensure that
it has either the POINTER or TARGET attributes.

I added an implementation and a test.

[klausler]

Why is this a fatal error, rather than a warning? If the TARGET= argument lacks both POINTER and TARGET attributes, the result will always be false, and we can warn about that.

[PeteSteinfeld]

In D89717#2339426, @klausler wrote:

Why is this a fatal error, rather than a warning? If the TARGET= argument lacks both POINTER and TARGET attributes, the result will always be false, and we can warn about that.

This same logic applies to all invalid TARGET= arguments. GNU, pgf90, IBM, Intel, and NAG all consider this an error. I think that we should. too.

flang/lib/Evaluate/intrinsics.cpp

if (const auto *pointerExpr{pointerArg->UnwrapExpr()}) {
                 AttachDeclaration(
                     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 {
                 // object pointer and target
+                if (const Symbol * targetSymbol{GetLastSymbol(*targetExpr)}) {
+                  if (!(targetSymbol->attrs().test(semantics::Attr::POINTER) ||
+                          targetSymbol->attrs().test(
+                              semantics::Attr::TARGET))) {
+                    AttachDeclaration(
+                        messages.Say("TARGET= argument '%s' must have either "
+                                     "the POINTER or the TARGET "
+                                     "attribute"_err_en_US,
+                            targetName),
+                        *targetSymbol);
+                  }
+                }
+
                 if (const auto pointerType{pointerArg->GetType()}) {
                   if (const auto targetType{targetArg->GetType()}) {
                     ok = pointerType->IsTkCompatibleWith(*targetType);
                   }
                 }
               }
             }
           }

flang/test/Semantics/associated.f90

subroutine test()
     lVar = associated(null(), null(intPointerVar1)) !OK
     lVar = associated(null(intPointerVar1), null()) !OK
     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
     lVar = associated(intVar)
     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
     lVar = associated(intVar, intVar)
     !ERROR: POINTER= argument of ASSOCIATED() must be a POINTER
     lVar = associated(intAllocVar)
-    lVar = associated(intPointerVar1, intVar) !OK
     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
     lVar = associated(intPointerVar1, targetRealVar)
     lVar = associated(intPointerVar1, targetIntVar1) !OK
     !ERROR: Arguments of ASSOCIATED() must be a POINTER and an optional valid target
     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)
 
     ! 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