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

[via flang-commits]

Author: Peter Klausler
Date: 2023-11-13T15:37:54-08:00
New Revision: f06ea103e75b2919ba2666128581f1b877d2893e

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

LOG: [flang] Do definability checking in RANK() clauses (#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.

Added: 
    

Modified: 
    flang/lib/Semantics/definable.cpp
    flang/test/Semantics/select-rank03.f90

Removed: 
    


################################################################################
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