[flang] Correct epistemological edge cases for IS_CONTIGUOUS folding

[klausler]

Summary

Don't return a hard .FALSE. when folding IS_CONTIGUOUS() unless the
subscript triplets are discontiguous and array section is nonempty,
or if the array section is nonempty and there is a vector subscript.

[clementval]

LGTM

flang/include/flang/Evaluate/variable.h

   Triplet &set_stride(Expr<SubscriptInteger> &&);
 
   bool operator==(const Triplet &) const;
-  std::optional<bool> IsStrideOne() const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
 
 private:

flang/lib/Evaluate/check-expression.cpp

       return true; // scalars considered contiguous
     }
     int subscriptRank{0};
-    auto subscripts{CheckSubscripts(x.subscript(), subscriptRank)};
+    auto baseLbounds{GetLBOUNDs(context_, x.base())};
+    auto baseUbounds{GetUBOUNDs(context_, x.base())};
+    auto subscripts{CheckSubscripts(
+        x.subscript(), subscriptRank, &baseLbounds, &baseUbounds)};
     if (!subscripts.value_or(false)) {
       return subscripts; // subscripts not known to be contiguous
     } else if (subscriptRank > 0) {

   Result operator()(const NullPointer &) const { return true; }
 
 private:
-  static std::optional<bool> CheckSubscripts(
-      const std::vector<Subscript> &subscript, int &rank) {
+  // Returns "true" for a provably empty or simply contiguous array section;
+  // return "false" for a provably nonempty discontiguous section or for use
+  // of a vector subscript.
+  std::optional<bool> CheckSubscripts(const std::vector<Subscript> &subscript,
+      int &rank, const Shape *baseLbounds = nullptr,
+      const Shape *baseUbounds = nullptr) const {
     bool anyTriplet{false};
     rank = 0;
+    // Detect any provably empty dimension in this array section, which would
+    // render the whole section empty and therefore vacuously contiguous.
+    std::optional<bool> result;
     for (auto j{subscript.size()}; j-- > 0;) {
       if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
-        auto isStride1{triplet->IsStrideOne()};
-        if (!isStride1.value_or(false)) {
-          return isStride1;
+        ++rank;
+        if (auto stride{ToInt64(triplet->stride())}) {
+          const Expr<SubscriptInteger> *lowerBound{triplet->GetLower()};
+          if (!lowerBound && baseLbounds && j < baseLbounds->size()) {
+            lowerBound = common::GetPtrFromOptional(baseLbounds->at(j));
+          }
+          const Expr<SubscriptInteger> *upperBound{triplet->GetUpper()};
+          if (!upperBound && baseUbounds && j < baseUbounds->size()) {
+            upperBound = common::GetPtrFromOptional(baseUbounds->at(j));
+          }
+          std::optional<ConstantSubscript> lowerVal{lowerBound
+                  ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*lowerBound}))
+                  : std::nullopt};
+          std::optional<ConstantSubscript> upperVal{upperBound
+                  ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*upperBound}))
+                  : std::nullopt};
+          if (lowerVal && upperVal) {
+            if (*lowerVal < *upperVal) {
+              if (*stride < 0) {
+                result = true; // empty dimension
+              } else if (!result && *stride > 1 &&
+                  *lowerVal + *stride <= *upperVal) {
+                result = false; // discontiguous if not empty
+              }
+            } else if (*lowerVal > *upperVal) {
+              if (*stride > 0) {
+                result = true; // empty dimension
+              } else if (!result && *stride < 0 &&
+                  *lowerVal + *stride >= *upperVal) {
+                result = false; // discontiguous if not empty
+              }
+            }
+          }
+        }
+      } else if (subscript[j].Rank() > 0) {
+        ++rank;
+        if (!result) {
+          result = false; // vector subscript
+        }
+      }
+    }
+    if (rank == 0) {
+      result = true; // scalar
+    }
+    if (result) {
+      return result;
+    }
+    // Not provably discontiguous at this point.
+    // Return "true" if simply contiguous, otherwise nullopt.
+    for (auto j{subscript.size()}; j-- > 0;) {
+      if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
+        auto stride{ToInt64(triplet->stride())};
+        if (!stride || stride != 1) {
+          return std::nullopt;
         } else if (anyTriplet) {
-          if (triplet->lower() || triplet->upper()) {
+          if (triplet->GetLower() || triplet->GetUpper()) {
             // all triplets before the last one must be just ":" for
             // simple contiguity
             return std::nullopt;

           anyTriplet = true;
         }
         ++rank;
-      } else if (anyTriplet || subscript[j].Rank() > 0) {
-        return false;
+      } else if (anyTriplet) {
+        return std::nullopt;
       }
     }
-    return true;
+    return true; // simply contiguous
   }
 
   FoldingContext &context_;

flang/lib/Evaluate/variable.cpp

   return *this;
 }
 
-std::optional<bool> Triplet::IsStrideOne() const {
-  if (auto stride{ToInt64(stride_.value())}) {
-    return stride == 1;
-  } else {
-    return std::nullopt;
-  }
-}
-
 CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector<Subscript> &&ss,
     std::vector<Expr<SubscriptInteger>> &&css)
     : base_{std::move(base)}, subscript_(std::move(ss)),

flang/test/Semantics/assign03.f90

     logical(kind=merge(1,-1,is_contiguous(pc(:)))) :: l8 ! known true
     logical(kind=merge(-1,1,is_contiguous(pc(1:10:2)))) :: l9 ! known false
     logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l10 ! known false
+    logical(kind=merge(1,-1,is_contiguous(pc(1:10:1)))) :: l11 ! known true
+    logical(kind=merge(-1,1,is_contiguous(pc(10:1:-1)))) :: l12 ! known false
+    !ERROR: Must be a constant value
+    logical(kind=merge(-1,1,is_contiguous(pc(::-1)))) :: l13 ! unknown (could be empty)
+    logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(::-1,1)))) :: l14 ! known true (empty)
+    logical(kind=merge(1,-1,is_contiguous(y(1,1)%a(1,::-1)))) :: l15 ! known true (empty)
   end
   subroutine test3(b)
     integer, intent(inout) :: b(..)