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

[via flang-commits]

Author: Peter Klausler
Date: 2024-05-23T15:56:08-07:00
New Revision: 8ccb56cf3500ad41192881a3a7b07513bea79281

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

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

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.

Added: 
    

Modified: 
    flang/lib/Evaluate/shape.cpp
    flang/test/Semantics/shape.f90

Removed: 
    


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