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

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-07-17T12:35:12-07:00
New Revision: 755180cf1bae896c04efd49ddb71d7eb2dede490

URL: https://github.com/llvm/llvm-project/commit/755180cf1bae896c04efd49ddb71d7eb2dede490
DIFF: https://github.com/llvm/llvm-project/commit/755180cf1bae896c04efd49ddb71d7eb2dede490.diff

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

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.

Differential Revision: https://reviews.llvm.org/D155494

Added: 
    

Modified: 
    flang/lib/Evaluate/fold-integer.cpp
    flang/test/Semantics/misc-intrinsics.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index fdf6201c2284ed..b87a01bf0b2141 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -115,14 +115,14 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
   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 {
@@ -169,14 +169,14 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
   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 {
@@ -194,8 +194,8 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
           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)}) {

diff  --git a/flang/test/Semantics/misc-intrinsics.f90 b/flang/test/Semantics/misc-intrinsics.f90
index 31efc3e6c14b5c..00018f6752eacb 100644
--- a/flang/test/Semantics/misc-intrinsics.f90
+++ b/flang/test/Semantics/misc-intrinsics.f90
@@ -3,10 +3,11 @@
 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
@@ -21,6 +22,13 @@ subroutine test(arg)
     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)
@@ -32,5 +40,15 @@ subroutine test(arg)
     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