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

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D155494

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


Index: flang/test/Semantics/misc-intrinsics.f90
===================================================================
--- flang/test/Semantics/misc-intrinsics.f90
+++ 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 @@
     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 @@
     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
Index: flang/lib/Evaluate/fold-integer.cpp
===================================================================
--- flang/lib/Evaluate/fold-integer.cpp
+++ flang/lib/Evaluate/fold-integer.cpp
@@ -115,14 +115,14 @@
   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 @@
   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 @@
           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)}) {


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D155494.541122.patch
Type: text/x-patch
Size: 4225 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230717/05e4c1e8/attachment.bin>