[flang-commits] [flang] [flang] Do definability checking in RANK() clauses (PR #71607)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/71607

I explicitly skipped definability checking for construct entities under a RANK() clause.  I don't know what I was thinking at the time; it's obviously incorrect!  Fix, and add tests.

>From b2090e00231aa397a7b9d2d138e80f3666928552 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 7 Nov 2023 15:54:07 -0800
Subject: [PATCH] [flang] Do definability checking in RANK() clauses

I explicitly skipped definability checking for construct entities
under a RANK() clause.  I don't know what I was thinking at the
time; it's obviously incorrect!  Fix, and add tests.
---
 flang/lib/Semantics/definable.cpp      |  4 +---
 flang/test/Semantics/select-rank03.f90 | 23 +++++++++++++++++++++++
 2 files changed, 24 insertions(+), 3 deletions(-)

diff --git a/flang/lib/Semantics/definable.cpp b/flang/lib/Semantics/definable.cpp
index 7e33357734fa724..d5ffcabc7233ca9 100644
--- a/flang/lib/Semantics/definable.cpp
+++ b/flang/lib/Semantics/definable.cpp
@@ -95,9 +95,7 @@ static std::optional<parser::Message> WhyNotDefinableBase(parser::CharBlock at,
   bool acceptAllocatable{flags.test(DefinabilityFlag::AcceptAllocatable)};
   bool isTargetDefinition{!isPointerDefinition && IsPointer(ultimate)};
   if (const auto *association{ultimate.detailsIf<AssocEntityDetails>()}) {
-    if (association->rank().has_value()) {
-      return std::nullopt; // SELECT RANK always modifiable variable
-    } else if (!IsVariable(association->expr())) {
+    if (!IsVariable(association->expr())) {
       return BlameSymbol(at,
           "'%s' is construct associated with an expression"_en_US, original);
     } else if (evaluate::HasVectorSubscript(association->expr().value())) {
diff --git a/flang/test/Semantics/select-rank03.f90 b/flang/test/Semantics/select-rank03.f90
index 234bd1a115493de..8a965e950d38513 100644
--- a/flang/test/Semantics/select-rank03.f90
+++ b/flang/test/Semantics/select-rank03.f90
@@ -130,4 +130,27 @@ subroutine pointers(p)
       p => t1
     end select
   end
+  subroutine undefinable(p)
+    real, pointer, intent(in) :: p(..)
+    real, target :: t
+    select rank(p)
+    rank (0)
+      !ERROR: The left-hand side of a pointer assignment is not definable
+      !BECAUSE: 'p' is an INTENT(IN) dummy argument
+      p => t
+      !ERROR: Name in DEALLOCATE statement is not definable
+      !BECAUSE: 'p' is an INTENT(IN) dummy argument
+      deallocate(p)
+    !ERROR: RANK (*) cannot be used when selector is POINTER or ALLOCATABLE
+    rank (*)
+      !ERROR: Whole assumed-size array 'p' may not appear here without subscripts
+      !ERROR: Name in DEALLOCATE statement is not definable
+      !BECAUSE: 'p' is an INTENT(IN) dummy argument
+      deallocate(p)
+    rank default
+      !ERROR: Name in DEALLOCATE statement is not definable
+      !BECAUSE: 'p' is an INTENT(IN) dummy argument
+      deallocate(p)
+    end select
+  end
 end