[flang-commits] [flang] [flang] Fix bad shape analysis of assumed-rank dummy (PR #92936)

[via flang-commits]

llvmbot wrote:


<!--LLVM PR SUMMARY COMMENT-->

@llvm/pr-subscribers-flang-semantics

Author: Peter Klausler (klausler)

<details>
<summary>Changes</summary>

Shape analysis for the results of SHAPE, LBOUND, and UBOUND (without DIM=) needs to account for an assumed-rank dummy argument, and return a shape vector with a single unknown element.

---
Full diff: https://github.com/llvm/llvm-project/pull/92936.diff


2 Files Affected:

- (modified) flang/lib/Evaluate/shape.cpp (+6-2) 
- (modified) flang/test/Semantics/shape.f90 (+8-2) 


``````````diff
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 6246cb931ff98..5cf48b240eca6 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -885,8 +885,12 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
         intrinsic->name == "ubound") {
       // For LBOUND/UBOUND, these are the array-valued cases (no DIM=)
       if (!call.arguments().empty() && call.arguments().front()) {
-        return Shape{
-            MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
+        if (IsAssumedRank(*call.arguments().front())) {
+          return Shape{MaybeExtentExpr{}};
+        } else {
+          return Shape{
+              MaybeExtentExpr{ExtentExpr{call.arguments().front()->Rank()}}};
+        }
       }
     } else if (intrinsic->name == "all" || intrinsic->name == "any" ||
         intrinsic->name == "count" || intrinsic->name == "iall" ||
diff --git a/flang/test/Semantics/shape.f90 b/flang/test/Semantics/shape.f90
index f43b81f2b44dc..21e293031fd6c 100644
--- a/flang/test/Semantics/shape.f90
+++ b/flang/test/Semantics/shape.f90
@@ -2,10 +2,12 @@
 ! Test comparisons that use the intrinsic SHAPE() as an operand
 program testShape
 contains
-  subroutine sub1(arrayDummy)
-    integer :: arrayDummy(:)
+  subroutine sub1(arrayDummy, assumedRank)
+    integer :: arrayDummy(:), assumedRank(..)
     integer, allocatable :: arrayDeferred(:)
     integer :: arrayLocal(2) = [88, 99]
+    integer, parameter :: aRrs = rank(shape(assumedRank))
+    integer(kind=merge(kind(1),-1,aRrs == 1)) :: test_aRrs
     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
     !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
     if (all(shape(arrayDummy)==shape(8))) then
@@ -45,5 +47,9 @@ subroutine sub1(arrayDummy)
     if (all(64==shape(arrayLocal))) then
       print *, "hello"
     end if
+    ! These can't be checked at compilation time
+    if (any(shape(assumedRank) == [1])) stop
+    if (any(lbound(assumedRank) == [1,2])) stop
+    if (any(ubound(assumedRank) == [1,2,3])) stop
   end subroutine sub1
 end program testShape

``````````

</details>


https://github.com/llvm/llvm-project/pull/92936