[flang-commits] [flang] 6b66f1c - [flang] Another validity of the TARGET= argument of ASSOCIATED() for objects

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2020-10-21T10:17:27-07:00
New Revision: 6b66f1cd9ba4533904a733329890e911ae0f5f6f

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

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

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.

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

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 83fdc76c9bcd..eaff9620a22d 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -1959,6 +1959,19 @@ static bool CheckAssociated(SpecificCall &call,
                     *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);

diff  --git a/flang/test/Semantics/associated.f90 b/flang/test/Semantics/associated.f90
index b78ccb017b16..641b7d97d78a 100644
--- a/flang/test/Semantics/associated.f90
+++ b/flang/test/Semantics/associated.f90
@@ -74,7 +74,6 @@ subroutine test()
     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
@@ -82,6 +81,10 @@ 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)
 
     ! Procedure pointer tests
     intprocPointer1 => intProc !OK