diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp index 96af46abd61802..d594b1eca567f8 100644 --- a/flang/lib/Semantics/definable.cpp +++ b/flang/lib/Semantics/definable.cpp @@ -178,7 +178,10 @@ static std::optional WhyNotDefinableBase(parser::CharBlock at, static std::optional WhyNotDefinableLast(parser::CharBlock at, const Scope &scope, DefinabilityFlags flags, const Symbol &original) { const Symbol &ultimate{original.GetUltimate()}; - if (const auto *association{ultimate.detailsIf()}) { + if (const auto *association{ultimate.detailsIf()}; + 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()); diff --git a/flang/test/Semantics/associate03.f90 b/flang/test/Semantics/associate03.f90 new file mode 100644 index 00000000000000..f57dc17839aabb --- /dev/null +++ b/flang/test/Semantics/associate03.f90 @@ -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