[flang] Detect UBOUND() error on assumed-size array

[klausler]

Summary

UBOUND() is not allowed on the last dimension of an
assumed-size array dummy argument.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/lib/Evaluate/fold-integer.cpp

Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
   if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{GetInt64Arg(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
             context.messages().Say("DIM=%jd dimension is out of range for "
-                                   "rank-%d array"_en_US,
+                                   "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)};
Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
   if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
     if (int rank{array->Rank()}; rank > 0) {
       std::optional<int> dim;
       if (funcRef.Rank() == 0) {
         // Optional DIM= argument is present: result is scalar.
         if (auto dim64{GetInt64Arg(args[1])}) {
           if (*dim64 < 1 || *dim64 > rank) {
             context.messages().Say("DIM=%jd dimension is out of range for "
-                                   "rank-%d array"_en_US,
+                                   "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) {
-              return Expr<T>{-1};
+            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,
+                  rank, rank);
+              return MakeInvalidIntrinsic<T>(std::move(funcRef));
             } else if (auto ub{GetUpperBound(context, *named, *dim)}) {
               return Fold(context, ConvertToType<T>(std::move(*ub)));
             }
           } else {
             Shape ubounds{GetUpperBounds(context, *named)};
             if (semantics::IsAssumedSizeArray(symbol)) {
               CHECK(!ubounds.back());
               ubounds.back() = ExtentExpr{-1};

flang/test/Evaluate/folding19.f90

+! RUN: not %f18 %s 2>&1 | FileCheck %s
+! Check errors found in folding
+! TODO: test others emitted from flang/lib/Evaluate
+module m
+ contains
+  subroutine s1(a,b)
+    real :: a(*), b(:)
+    !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 is out of range for rank-1 array
+    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 is out of range for rank-1 array
+    integer :: lb2(lbound(b,0))
+    !CHECK: error: DIM=2 dimension is out of range for rank-1 array
+    integer :: lb3(lbound(b,2))
+  end subroutine
+end module
+

flang/test/Semantics/spec-expr.f90

 ! a specification inquiry where each designator or argument is
 !   (b) a variable that is not an optional dummy argument, and whose
 !     properties inquired about are not
 !     (i)   dependent on the upper bound of the last dimension of an 
 !       assumed-size array,
 subroutine s7bi(assumedArg)
   integer, dimension(2, *) :: assumedArg
   real, dimension(ubound(assumedArg, 1)) :: realArray1
-  ! Should be an error since 2 is the last dimension of an assumed-size array
+  !ERROR: DIM=2 dimension is out of range for rank-2 assumed-size array
   real, dimension(ubound(assumedArg, 2)) :: realArray2
 end subroutine s7bi
 
 ! a specification inquiry where each designator or argument is
 !   (b) a variable that is not an optional dummy argument, and whose
 !     properties inquired about are not
 !     (ii)  deferred, or
 subroutine s7bii(dummy)