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

[via flang-commits]

Author: Peter Klausler
Date: 2024-07-18T16:14:19-07:00
New Revision: e73d51d3c8ea61fa34658f22147e65f95411eca2

URL: https://github.com/llvm/llvm-project/commit/e73d51d3c8ea61fa34658f22147e65f95411eca2
DIFF: https://github.com/llvm/llvm-project/commit/e73d51d3c8ea61fa34658f22147e65f95411eca2.diff

LOG: [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.

Added: 
    flang/test/Semantics/associate03.f90

Modified: 
    flang/lib/Semantics/definable.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index 96af46abd6180..d594b1eca567f 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/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());

diff  --git a/flang/test/Semantics/associate03.f90 b/flang/test/Semantics/associate03.f90
new file mode 100644
index 0000000000000..f57dc17839aab
--- /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