[flang] ASSOCIATE/SELECT TYPE entities aren't pointer/allocatable (#9…

…9364)

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.

flang/lib/Semantics/definable.cpp

@@ -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());

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