[flang] Avoid bogus errors with LBOUND/UBOUND(assumed rank array, DIM=)

[klausler]

Summary

Don't emit bogus compile-time error messages about out-of-range values
for the DIM= argument to LBOUND/BOUND when the array in question is an
assumed-rank dummy array argument.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/fold-integer.cpp

 };
 
 template <int KIND>
 Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Integer, KIND>;
   ActualArguments &args{funcRef.arguments()};
   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
-    if (int rank{array->Rank()}; rank > 0) {
+    if (int rank{array->Rank()}; rank > 0 && !IsAssumedRank(*array)) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{ToInt64(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
-            context.messages().Say("DIM=%jd dimension is out of range for "
-                                   "rank-%d array"_err_en_US,
+            context.messages().Say(
+                "DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
                 *dim64, rank);
             return MakeInvalidIntrinsic<T>(std::move(funcRef));
           } else {
             dim = *dim64 - 1; // 1-based to 0-based
           }
         } else {
           // DIM= is present but not constant
           return Expr<T>{std::move(funcRef)};

 }
 
 template <int KIND>
 Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
     FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
   using T = Type<TypeCategory::Integer, KIND>;
   ActualArguments &args{funcRef.arguments()};
   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
-    if (int rank{array->Rank()}; rank > 0) {
+    if (int rank{array->Rank()}; rank > 0 && !IsAssumedRank(*array)) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{ToInt64(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
-            context.messages().Say("DIM=%jd dimension is out of range for "
-                                   "rank-%d array"_err_en_US,
+            context.messages().Say(
+                "DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
                 *dim64, rank);
             return MakeInvalidIntrinsic<T>(std::move(funcRef));
           } else {
             dim = *dim64 - 1; // 1-based to 0-based
           }
         } else {
           // DIM= is present but not constant
           return Expr<T>{std::move(funcRef)};
         }
       }
       bool takeBoundsFromShape{true};
       if (auto named{ExtractNamedEntity(*array)}) {
         const Symbol &symbol{named->GetLastSymbol()};
         if (symbol.Rank() == rank) {
           takeBoundsFromShape = false;
           if (dim) {
             if (semantics::IsAssumedSizeArray(symbol) && *dim == rank - 1) {
-              context.messages().Say("DIM=%jd dimension is out of range for "
-                                     "rank-%d assumed-size array"_err_en_US,
+              context.messages().Say(
+                  "DIM=%jd dimension is out of range for rank-%d assumed-size array"_err_en_US,
                   rank, rank);
               return MakeInvalidIntrinsic<T>(std::move(funcRef));
             } else if (auto ub{GetUBOUND(context, *named, *dim)}) {
               return Fold(context, ConvertToType<T>(std::move(*ub)));
             }
           } else {
             Shape ubounds{GetUBOUNDs(context, *named)};
             if (semantics::IsAssumedSizeArray(symbol)) {

flang/test/Semantics/misc-intrinsics.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Miscellaneous constraint and requirement checking on intrinsics
 program test_size
   real :: scalar
   real, dimension(5, 5) :: array
-  call test(array)
+  call test(array, array)
  contains
-  subroutine test(arg)
+  subroutine test(arg, assumedRank)
     real, dimension(5, *) :: arg
+    real, dimension(..) :: assumedRank
     !ERROR: A dim= argument is required for 'size' when the array is assumed-size
     print *, size(arg)
     !ERROR: missing mandatory 'dim=' argument
     print *, ubound(arg)
     !ERROR: The 'source=' argument to the intrinsic function 'shape' may not be assumed-size
     print *, shape(arg)
     !ERROR: The 'harvest=' argument to the intrinsic procedure 'random_number' may not be assumed-size
     call random_number(arg)
     !ERROR: missing mandatory 'dim=' argument
     print *, lbound(scalar)
     !ERROR: 'array=' argument has unacceptable rank 0
     print *, size(scalar)
     !ERROR: missing mandatory 'dim=' argument
     print *, ubound(scalar)
+    select rank(assumedRank)
+    rank(1)
+      !ERROR: DIM=2 dimension is out of range for rank-1 array
+      print *, lbound(assumedRank, dim=2)
+      !ERROR: DIM=2 dimension is out of range for rank-1 array
+      print *, ubound(assumedRank, dim=2)
+    end select
     ! But these cases are fine:
     print *, size(arg, dim=1)
     print *, ubound(arg, dim=1)
     print *, lbound(arg)
     print *, size(array)
     print *, ubound(array)
     print *, lbound(array)
     print *, size(arg(:,1))
     print *, ubound(arg(:,1))
     print *, shape(scalar)
     print *, shape(arg(:,1))
+    print *, lbound(assumedRank, dim=2) ! can't check until run time
+    print *, ubound(assumedRank, dim=2)
+    select rank(assumedRank)
+    rank(3)
+      print *, lbound(assumedRank, dim=2)
+      print *, ubound(assumedRank, dim=2)
+    rank default
+      print *, lbound(assumedRank, dim=2)
+      print *, ubound(assumedRank, dim=2)
+    end select
   end subroutine
 end