[flang] More subscript triplet checking at compilation time

[klausler]

Summary

When a triplet's lower and upper bounds are the same, we can
check them without requiring a constant stride.

flang/lib/Semantics/expression.cpp

void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) {
   Shape ub{GetUBOUNDs(foldingContext_, ref.base())};
   bool anyPossiblyEmptyDim{false};
   int dim{0};
   for (Subscript &ss : ref.subscript()) {
     if (Triplet * triplet{std::get_if<Triplet>(&ss.u)}) {
       auto expr{Fold(triplet->stride())};
       auto stride{ToInt64(expr)};
       triplet->set_stride(std::move(expr));
-      if (stride) {
-        if (*stride == 0) {
-          Say("Stride of triplet must not be zero"_err_en_US);
-          return;
-        }
-        std::optional<ConstantSubscript> lower, upper;
-        if (auto expr{triplet->lower()}) {
-          *expr = Fold(std::move(*expr));
-          lower = ToInt64(*expr);
-          triplet->set_lower(std::move(*expr));
-        } else {
-          lower = ToInt64(lb[dim]);
-        }
-        if (auto expr{triplet->upper()}) {
-          *expr = Fold(std::move(*expr));
-          upper = ToInt64(*expr);
-          triplet->set_upper(std::move(*expr));
-        } else {
-          upper = ToInt64(ub[dim]);
-        }
+      if (stride) {
+        if (*stride == 0) {
+          Say("Stride of triplet must not be zero"_err_en_US);
+          return;
+        }
         if (lower && upper) {
           if (*stride > 0) {
             anyPossiblyEmptyDim |= *lower > *upper;
           } else {
             anyPossiblyEmptyDim |= *lower < *upper;
           }
         } else {
           anyPossiblyEmptyDim = true;
         }
+      } else { // non-constant stride
+        if (lower && upper && *lower == *upper) {
+          // stride is not relevant
         } else {
           anyPossiblyEmptyDim = true;
         }
+      }
     } else { // not triplet
       auto &expr{std::get<IndirectSubscriptIntegerExpr>(ss.u).value()};
       expr = Fold(std::move(expr));
       anyPossiblyEmptyDim |= expr.Rank() > 0; // vector subscript
     }
     ++dim;
   }
   if (anyPossiblyEmptyDim) {
if (auto *triplet{std::get_if<Triplet>(&ss.u)}) {
       } else if (lb[dim]) {
         lower = ToInt64(*lb[dim]);
       }
       if (const auto *upperExpr{triplet->GetUpper()}) {
         upper = ToInt64(*upperExpr);
       } else if (ub[dim]) {
         upper = ToInt64(*ub[dim]);
       }
-      if (stride && *stride != 0 && lower && upper) {
+      if (lower) {
+        val[vals++] = *lower;
+        if (upper && *upper != lower && (stride && *stride != 0)) {
           // Normalize upper bound for non-unit stride
           // 1:10:2 -> 1:9:2, 10:1:-2 -> 10:2:-2
-        *upper = *lower + *stride * ((*upper - *lower) / *stride);
-        val[vals++] = lower;
-        val[vals++] = upper;
+          val[vals++] = *lower + *stride * ((*upper - *lower) / *stride);
+        }
       }
     } else {
       val[vals++] =
           ToInt64(std::get<IndirectSubscriptIntegerExpr>(ss.u).value());
     }
     for (int j{0}; j < vals; ++j) {
       if (val[j]) {
         if (dimLB && *val[j] < *dimLB) {

flang/test/Semantics/expr-errors06.f90

 ! 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
 end
-