[flang] ASSOCIATE/SELECT TYPE entities aren't pointer/allocatable (#99364)

Fix what seems to be a regression in semantics in definability checking:
the construct entities of ASSOCIATE and SELECT TYPE constructs are never
pointers or allocatables, even when their selectors are so. SELECT RANK
construct entities, however, can be pointers or allocatables.
This commit is contained in:
Peter Klausler 2024-07-18 16:14:19 -07:00 committed by GitHub
parent 433e09cf25
commit e73d51d3c8
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
2 changed files with 83 additions and 1 deletions

View File

@ -178,7 +178,10 @@ static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
static std::optional<parser::Message> WhyNotDefinableLast(parser::CharBlock at,
const Scope &scope, DefinabilityFlags flags, const Symbol &original) {
const Symbol &ultimate{original.GetUltimate()};
if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()}) {
if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()};
association &&
(association->rank().has_value() ||
!flags.test(DefinabilityFlag::PointerDefinition))) {
if (auto dataRef{
evaluate::ExtractDataRef(*association->expr(), true, true)}) {
return WhyNotDefinableLast(at, scope, flags, dataRef->GetLastSymbol());

View File

@ -0,0 +1,79 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
! A construct entity does not have the POINTER or ALLOCATABLE attribute,
! except in SELECT RANK.
subroutine test(up,ua,rp,ra)
class(*), pointer :: up
class(*), allocatable :: ua
real, pointer :: rp(..)
real, allocatable :: ra(..)
real, target :: x
real, pointer :: p
real, allocatable :: a
associate (s => p)
!ERROR: The left-hand side of a pointer assignment is not definable
!BECAUSE: 's' is not a pointer
s => x
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(s)
!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
deallocate(s)
!ERROR: 's' may not appear in NULLIFY
!BECAUSE: 's' is not a pointer
nullify(s)
end associate
select type(s => up)
type is (real)
!ERROR: The left-hand side of a pointer assignment is not definable
!BECAUSE: 's' is not a pointer
s => x
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(s)
!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
deallocate(s)
!ERROR: 's' may not appear in NULLIFY
!BECAUSE: 's' is not a pointer
nullify(s)
end select
select rank(s => rp)
rank(0)
s => x ! ok
allocate(s) ! ok
deallocate(s) ! ok
nullify(s) ! ok
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
rank(*)
rank default
!ERROR: The left-hand side of a pointer assignment must not be an assumed-rank dummy argument
!ERROR: pointer 's' associated with object 'x' with incompatible type or shape
s => x
!ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
allocate(s)
deallocate(s) ! ok
nullify(s) ! ok
end select
associate (s => a)
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(s)
!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
deallocate(s)
end associate
select type(s => ua)
type is (real)
!ERROR: Entity in ALLOCATE statement must have the ALLOCATABLE or POINTER attribute
allocate(s)
!ERROR: Name in DEALLOCATE statement must have the ALLOCATABLE or POINTER attribute
deallocate(s)
end select
select rank(s => ra)
rank(0)
allocate(s) ! ok
deallocate(s) ! ok
!ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
rank(*)
rank default
!ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
allocate(s)
deallocate(s) ! ok
end select
end