[flang] Fix checking of pointer target with association

When checking if the target of a pointer assignment is valid, we
weren't following associations. E.g. we complained about the assignment
below if `b` had the TARGET attribute but `c` did not:
```
associate(a => b%c)
  p => a
end associate
```

The fix is to change `GetSymbolVector()` to follow associations in
creating the chain of symbols from a designator.

Add tests for this, and also some other cases where TARGET is on the
derived type variable rather than the component (which worked but didn't
have tests).

Original-commit: flang-compiler/f18@c81c6baedd41d6ca2d36c81ca745a144c02be369
Reviewed-on: https://github.com/flang-compiler/f18/pull/937

diff --git a/flang/lib/evaluate/tools.cc b/flang/lib/evaluate/tools.cc
index fc5b579..2ea4719 100644 (file)
--- a/flang/lib/evaluate/tools.cc
+++ b/flang/lib/evaluate/tools.cc
@@ -709,7 +709,11 @@ bool IsNullPointer(const Expr<SomeType> &expr) {
 
 // GetSymbolVector()
 auto GetSymbolVectorHelper::operator()(const Symbol &x) const -> Result {
-  return {x};
+  if (const auto *details{x.detailsIf<semantics::AssocEntityDetails>()}) {
+    return (*this)(details->expr());
+  } else {
+    return {x.GetUltimate()};
+  }
 }
 auto GetSymbolVectorHelper::operator()(const Component &x) const -> Result {
   Result result{(*this)(x.base())};

diff --git a/flang/lib/semantics/pointer-assignment.cc b/flang/lib/semantics/pointer-assignment.cc
index fc2b07a..ab51f09 100644 (file)
--- a/flang/lib/semantics/pointer-assignment.cc
+++ b/flang/lib/semantics/pointer-assignment.cc
@@ -211,8 +211,10 @@ void PointerAssignmentChecker::Check(const evaluate::Designator<T> &d) {
     }
   }
   if (msg) {
+    std::ostringstream ss;
+    d.AsFortran(ss);
     auto restorer{common::ScopedSet(lhs_, last)};
-    Say(*msg, description_, last->name());
+    Say(*msg, description_, ss.str());
   }
 }
 

diff --git a/flang/test/semantics/assign02.f90 b/flang/test/semantics/assign02.f90
index 89317aa..60f560b 100644 (file)
--- a/flang/test/semantics/assign02.f90
+++ b/flang/test/semantics/assign02.f90
@@ -151,3 +151,43 @@ contains
   end
 
 end
+
+module m2
+  type :: t1
+    real :: a
+  end type
+  type :: t2
+    type(t1) :: b
+    type(t1), pointer :: c
+    real :: d
+  end type
+end
+
+subroutine s2
+  use m2
+  real, pointer :: p
+  type(t2), target :: x
+  type(t2) :: y
+  !OK: x has TARGET attribute
+  p => x%b%a
+  !OK: c has POINTER attribute
+  p => y%c%a
+  !ERROR: In assignment to object pointer 'p', the target 'y%b%a' is not an object with POINTER or TARGET attributes
+  p => y%b%a
+  associate(z => x%b)
+    !OK: x has TARGET attribute
+    p => z%a
+  end associate
+  associate(z => y%c)
+    !OK: c has POINTER attribute
+    p => z%a
+  end associate
+  associate(z => y%b)
+    !ERROR: In assignment to object pointer 'p', the target 'z%a' is not an object with POINTER or TARGET attributes
+    p => z%a
+  end associate
+  associate(z => y%b%a)
+    !ERROR: In assignment to object pointer 'p', the target 'z' is not an object with POINTER or TARGET attributes
+    p => z
+  end associate
+end