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

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
PeteSteinfeld added reviewers: klausler, tskeith.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.
PeteSteinfeld requested review of this revision.

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.


Repository:
  rG LLVM Github Monorepo

https://reviews.llvm.org/D89717

Files:
  flang/lib/Evaluate/intrinsics.cpp
  flang/test/Semantics/associated.f90


Index: flang/test/Semantics/associated.f90
===================================================================
--- flang/test/Semantics/associated.f90
+++ flang/test/Semantics/associated.f90
@@ -74,7 +74,6 @@
     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 @@
     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
Index: flang/lib/Evaluate/intrinsics.cpp
===================================================================
--- flang/lib/Evaluate/intrinsics.cpp
+++ flang/lib/Evaluate/intrinsics.cpp
@@ -1922,6 +1922,19 @@
                     *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);


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D89717.299107.patch
Type: text/x-patch
Size: 2322 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20201019/5bfdc5be/attachment.bin>