[flang] Relax overindexing error to warning for last dummy dimension (#71725)

Compilation-time subscript value range checking should emit a warning,
not an error, when the indexed array is a dummy argument; there's
old-school codes out there that should have used assumed-size dummy
arguments but didn't.

Author: klausler

flang/lib/Semantics/expression.cpp

@@ -403,19 +403,28 @@ void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
     }
     for (int j{0}; j < vals; ++j) {
       if (val[j]) {
+        std::optional<parser::MessageFixedText> msg;
+        std::optional<ConstantSubscript> bound;
         if (dimLB && *val[j] < *dimLB) {
-          AttachDeclaration(
-              Say("Subscript %jd is less than lower bound %jd for dimension %d of array"_err_en_US,
-                  static_cast<std::intmax_t>(*val[j]),
-                  static_cast<std::intmax_t>(*dimLB), dim + 1),
-              ref.base().GetLastSymbol());
+          msg =
+              "Subscript %jd is less than lower bound %jd for dimension %d of array"_err_en_US;
+          bound = *dimLB;
+        } else if (dimUB && *val[j] > *dimUB) {
+          msg =
+              "Subscript %jd is greater than upper bound %jd for dimension %d of array"_err_en_US;
+          bound = *dimUB;
+          if (dim + 1 == arraySymbol.Rank() && IsDummy(arraySymbol) &&
+              *bound == 1) {
+            // Old-school overindexing of a dummy array isn't fatal when
+            // it's on the last dimension and the extent is 1.
+            msg->set_severity(parser::Severity::Warning);
+          }
         }
-        if (dimUB && *val[j] > *dimUB) {
+        if (msg) {
           AttachDeclaration(
-              Say("Subscript %jd is greater than upper bound %jd for dimension %d of array"_err_en_US,
-                  static_cast<std::intmax_t>(*val[j]),
-                  static_cast<std::intmax_t>(*dimUB), dim + 1),
-              ref.base().GetLastSymbol());
+              Say(std::move(*msg), static_cast<std::intmax_t>(*val[j]),
+                  static_cast<std::intmax_t>(bound.value()), dim + 1),
+              arraySymbol);
         }
       }
     }

flang/test/Semantics/expr-errors06.f90

@@ -1,33 +1,42 @@
 ! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror
 ! Check out-of-range subscripts
-real a(10)
-integer, parameter :: n(2) = [1, 2]
-integer unknown
-!ERROR: DATA statement designator 'a(0_8)' is out of range
-!ERROR: DATA statement designator 'a(11_8)' is out of range
-data a(0)/0./, a(10+1)/0./
-!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
-print *, a(0)
-!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
-print *, a(1-1)
-!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
-print *, a(11)
-!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
-print *, a(10+1)
-!ERROR: Subscript value (0) is out of range on dimension 1 in reference to a constant array value
-print *, n(0)
-!ERROR: Subscript value (3) is out of range on dimension 1 in reference to a constant array value
-print *, n(4-1)
-print *, a(1:12:3) ! ok
-!ERROR: Subscript 13 is greater than upper bound 10 for dimension 1 of array
-print *, a(1:13:3)
-print *, a(10:-1:-3) ! ok
-!ERROR: Subscript -2 is less than lower bound 1 for dimension 1 of array
-print *, a(10:-2:-3)
-print *, a(-1:-2) ! empty section is ok
-print *, a(0:11:-1) ! empty section is ok
-!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
-print *, a(0:0:unknown) ! lower==upper, can ignore stride
-!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
-print *, a(11:11:unknown) ! lower==upper, can ignore stride
+subroutine subr(da)
+  real a(10), da(2,1)
+  integer, parameter :: n(2) = [1, 2]
+  integer unknown
+  !ERROR: DATA statement designator 'a(0_8)' is out of range
+  !ERROR: DATA statement designator 'a(11_8)' is out of range
+  data a(0)/0./, a(10+1)/0./
+  !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+  print *, a(0)
+  !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+  print *, a(1-1)
+  !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
+  print *, a(11)
+  !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
+  print *, a(10+1)
+  !ERROR: Subscript value (0) is out of range on dimension 1 in reference to a constant array value
+  print *, n(0)
+  !ERROR: Subscript value (3) is out of range on dimension 1 in reference to a constant array value
+  print *, n(4-1)
+  print *, a(1:12:3) ! ok
+  !ERROR: Subscript 13 is greater than upper bound 10 for dimension 1 of array
+  print *, a(1:13:3)
+  print *, a(10:-1:-3) ! ok
+  !ERROR: Subscript -2 is less than lower bound 1 for dimension 1 of array
+  print *, a(10:-2:-3)
+  print *, a(-1:-2) ! empty section is ok
+  print *, a(0:11:-1) ! empty section is ok
+  !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+  print *, a(0:0:unknown) ! lower==upper, can ignore stride
+  !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array
+  print *, a(11:11:unknown) ! lower==upper, can ignore stride
+  !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array
+  print *, da(0,1)
+  !ERROR: Subscript 3 is greater than upper bound 2 for dimension 1 of array
+  print *, da(3,1)
+  !ERROR: Subscript 0 is less than lower bound 1 for dimension 2 of array
+  print *, da(1,0)
+  !WARNING: Subscript 2 is greater than upper bound 1 for dimension 2 of array
+  print *, da(1,2)
 end