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

Author: klausler

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

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