[flang] Don't emit false errors on LBOUND/UBOUND of assumed-rank arrays

[klausler]

Summary

Folding of LBOUND/UBOUND on assumed-rank arrays could lead to bogus errors
later. This is a regression from a recent change intended to ensure that
patently bad DIM= arguments were caught even in the case of assumed-rank.
Rearrange the order of checks so that those bad DIM= argument values are
caught but otherwise defer LBOUND/UBOUND of assumed-rank arguments to
run time. (It was tempting to always fold LBOUND(ar,DIM=n) to 1, but
that would obscure the run time error required when 'n' is out of bounds,
including the case of a scalar 'ar'.)

[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 || IsAssumedRank(*array)) {
-      std::optional<int> dim;
-      if (funcRef.Rank() == 0) {
-        // Optional DIM= argument is present: result is scalar.
-        if (!CheckDimArg(args[1], *array, context.messages(), true, dim)) {
-          return MakeInvalidIntrinsic<T>(std::move(funcRef));
-        } else if (!dim) {
-          // DIM= is present but not constant, or error
-          return Expr<T>{std::move(funcRef)};
-        }
-      }
+    if (IsAssumedRank(*array)) {
+      // Would like to return 1 if DIM=.. is present, but that would be
+      // hiding a runtime error if the DIM= were too large (including
+      // the case of an assumed-rank argument that's scalar).
+    } else if (int rank{array->Rank()}; rank > 0) {
       bool lowerBoundsAreOne{true};
       if (auto named{ExtractNamedEntity(*array)}) {
         const Symbol &symbol{named->GetLastSymbol()};
         if (symbol.Rank() == rank) {
           lowerBoundsAreOne = false;
           if (dim) {
             if (auto lb{GetLBOUND(context, *named, *dim)}) {
               return Fold(context, ConvertToType<T>(std::move(*lb)));

 }
 
 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 || IsAssumedRank(*array)) {
-      std::optional<int> dim;
-      if (funcRef.Rank() == 0) {
-        // Optional DIM= argument is present: result is scalar.
-        if (!CheckDimArg(args[1], *array, context.messages(), false, dim)) {
-          return MakeInvalidIntrinsic<T>(std::move(funcRef));
-        } else if (!dim) {
-          // DIM= is present but not constant
-          return Expr<T>{std::move(funcRef)};
-        }
-      }
+        // DIM= is present but not constant, or error
+    if (IsAssumedRank(*array)) {
+    } else if (int rank{array->Rank()}; rank > 0) {
       bool takeBoundsFromShape{true};
       if (auto named{ExtractNamedEntity(*array)}) {
         const Symbol &symbol{named->GetLastSymbol()};
         if (symbol.Rank() == rank) {
           takeBoundsFromShape = false;
           if (dim) {
             if (auto ub{GetUBOUND(context, *named, *dim)}) {
               return Fold(context, ConvertToType<T>(std::move(*ub)));

flang/test/Evaluate/errors01.f90

 ! RUN: not %flang_fc1 %s 2>&1 | FileCheck %s
 ! Check errors found in folding
 ! TODO: test others emitted from flang/lib/Evaluate
 module m
   type t
     real x
   end type t
  contains
-  subroutine s1(a,b)
-    real :: a(*), b(:)
+  subroutine s1(a,b,c)
+    real :: a(*), b(:), c(..)
     !CHECK: error: DIM=1 dimension is out of range for rank-1 assumed-size array
     integer :: ub1(ubound(a,1))
     !CHECK-NOT: error: DIM=1 dimension is out of range for rank-1 assumed-size array
     integer :: lb1(lbound(a,1))
     !CHECK: error: DIM=0 dimension must be positive
     integer :: ub2(ubound(a,0))
     !CHECK: error: DIM=2 dimension is out of range for rank-1 array
     integer :: ub3(ubound(a,2))
     !CHECK: error: DIM=0 dimension must be positive
     integer :: lb2(lbound(b,0))
     !CHECK: error: DIM=2 dimension is out of range for rank-1 array
     integer :: lb3(lbound(b,2))
+    !CHECK: error: DIM=0 dimension must be positive
+    integer :: lb4(lbound(c,0))
+    !CHECK: error: DIM=666 dimension is too large for any array (maximum rank 15)
+    integer :: lb4(lbound(c,666))
   end subroutine
   subroutine s2
     integer, parameter :: array(2,3) = reshape([(j, j=1, 6)], shape(array))
     integer :: x(2, 3)
     !CHECK: error: Invalid 'dim=' argument (0) in CSHIFT
     x = cshift(array, [1, 2], dim=0)
     !CHECK: error: Invalid 'shift=' argument in CSHIFT: extent on dimension 1 is 2 but must be 3
     x = cshift(array, [1, 2], dim=1)