Skip to content

Commit

Permalink
[flang] Fix checking of pointer target with association
Browse files Browse the repository at this point in the history
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@c81c6ba
Reviewed-on: flang-compiler/f18#937
  • Loading branch information
tskeith committed Jan 15, 2020
1 parent f4e8eb5 commit 628a359
Show file tree
Hide file tree
Showing 3 changed files with 48 additions and 2 deletions.
6 changes: 5 additions & 1 deletion flang/lib/evaluate/tools.cc
Expand Up @@ -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())};
Expand Down
4 changes: 3 additions & 1 deletion flang/lib/semantics/pointer-assignment.cc
Expand Up @@ -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());
}
}

Expand Down
40 changes: 40 additions & 0 deletions flang/test/semantics/assign02.f90
Expand Up @@ -151,3 +151,43 @@ subroutine s10
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

0 comments on commit 628a359

Please sign in to comment.