[flang] Better IS_CONTIGUOUS folding for substrings (#115970)

At present, the compiler doesn't analyze substring references for
contiguity. But there are cases where substrings can be known to be
contiguous (scalar base, empty substring, or complete substring) or can
be known to be discontiguous, and references to the intrinsic function
IS_CONTIGUOUS in those cases may appear in constant expressions.

Fixes https://github.com/llvm/llvm-project/issues/115675.

6 files changed, 77 insertions, 11 deletions

diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 38794a2..998378c 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -908,7 +908,58 @@ public:
   Result operator()(const ComplexPart &x) const {
     return x.complex().Rank() == 0;
   }
-  Result operator()(const Substring &) const { return std::nullopt; }
+  Result operator()(const Substring &x) const {
+    if (x.Rank() == 0) {
+      return true; // scalar substring always contiguous
+    }
+    // Substrings with rank must have DataRefs as their parents
+    const DataRef &parentDataRef{DEREF(x.GetParentIf<DataRef>())};
+    std::optional<std::int64_t> len;
+    if (auto lenExpr{parentDataRef.LEN()}) {
+      len = ToInt64(Fold(context_, std::move(*lenExpr)));
+      if (len) {
+        if (*len <= 0) {
+          return true; // empty substrings
+        } else if (*len == 1) {
+          // Substrings can't be incomplete; is base array contiguous?
+          return (*this)(parentDataRef);
+        }
+      }
+    }
+    std::optional<std::int64_t> upper;
+    bool upperIsLen{false};
+    if (auto upperExpr{x.upper()}) {
+      upper = ToInt64(Fold(context_, common::Clone(*upperExpr)));
+      if (upper) {
+        if (*upper < 1) {
+          return true; // substring(n:0) empty
+        }
+        upperIsLen = len && *upper >= *len;
+      } else if (const auto *inquiry{
+                     UnwrapConvertedExpr<DescriptorInquiry>(*upperExpr)};
+                 inquiry && inquiry->field() == DescriptorInquiry::Field::Len) {
+        upperIsLen =
+            &parentDataRef.GetLastSymbol() == &inquiry->base().GetLastSymbol();
+      }
+    } else {
+      upperIsLen = true; // substring(n:)
+    }
+    if (auto lower{ToInt64(Fold(context_, x.lower()))}) {
+      if (*lower == 1 && upperIsLen) {
+        // known complete substring; is base contiguous?
+        return (*this)(parentDataRef);
+      } else if (upper) {
+        if (*upper < *lower) {
+          return true; // empty substring(3:2)
+        } else if (*lower > 1) {
+          return false; // known incomplete substring
+        } else if (len && *upper < *len) {
+          return false; // known incomplete substring
+        }
+      }
+    }
+    return std::nullopt; // contiguity not known
+  }
 
   Result operator()(const ProcedureRef &x) const {
     if (auto chars{characteristics::Procedure::Characterize(
diff --git a/flang/test/Evaluate/folding09.f90 b/flang/test/Evaluate/folding09.f90
index 863b5e8..534ff1a 100644
--- a/flang/test/Evaluate/folding09.f90
+++ b/flang/test/Evaluate/folding09.f90
@@ -5,7 +5,7 @@ module m
   real, target :: hosted(2)
   integer, parameter :: cst(2,2) = reshape([1, 2, 3, 4], shape(cst))
   integer, parameter :: empty_cst(2,0) = reshape([1], shape(empty_cst))
-  integer :: n
+  integer :: n, m
   logical, parameter :: test_param1 = is_contiguous(cst(:,1))
   logical, parameter :: test_param2 = is_contiguous(cst(1,:))
   logical, parameter :: test_param3 = is_contiguous(cst(:,n))
@@ -16,11 +16,15 @@ module m
     real, pointer, contiguous :: f(:)
     f => hosted
   end function
-  subroutine test(arr1, arr2, arr3, mat, alloc)
+  subroutine test(arr1, arr2, arr3, mat, alloc, alch)
     real, intent(in) :: arr1(:), arr2(10), mat(10, 10)
     real, intent(in), contiguous :: arr3(:)
     real, allocatable :: alloc(:)
     real :: scalar
+    character(5) charr(5)
+    character(1) char1(5)
+    character(0) char0(5)
+    character(*) alch(5)
     integer(kind=merge(1,-1,       is_contiguous(0)))               t01
     integer(kind=merge(1,-1,       is_contiguous(scalar)))          t02
     integer(kind=merge(1,-1,       is_contiguous(scalar + scalar))) t03
@@ -35,6 +39,17 @@ module m
     integer(kind=merge(1,-1, .not. is_contiguous(arr3(1:10:2))))    t12
     integer(kind=merge(1,-1,       is_contiguous(f())))             t13
     integer(kind=merge(1,-1,       is_contiguous(alloc)))           t14
+    integer(kind=merge(1,-1,       is_contiguous(charr(:)(:))))     t15
+    integer(kind=merge(1,-1,       is_contiguous(charr(1)(2:3))))   t16
+    integer(kind=merge(1,-1,       is_contiguous(charr(:)(1:))))    t17
+    integer(kind=merge(1,-1,       is_contiguous(charr(:)(3:2))))   t18
+    integer(kind=merge(1,-1,       is_contiguous(charr(:)(1:5))))   t19
+    integer(kind=merge(1,-1, .not. is_contiguous(charr(:)(1:4))))   t20
+    integer(kind=merge(1,-1,       is_contiguous(char1(:)(n:m))))   t21
+    integer(kind=merge(1,-1, .not. is_contiguous(char1(1:5:2)(n:m)))) t22
+    integer(kind=merge(1,-1,       is_contiguous(char0(:)(n:m))))   t23
+    integer(kind=merge(1,-1,       is_contiguous(char0(1:5:2)(n:m)))) t24
+    integer(kind=merge(1,-1,       is_contiguous(alch(:)(:))))      t25
     associate (x => arr2)
       block
         integer(kind=merge(1,-1,is_contiguous(x))) n
diff --git a/flang/test/Lower/HLFIR/maxloc.f90 b/flang/test/Lower/HLFIR/maxloc.f90
index 166a1b9..539affa 100644
--- a/flang/test/Lower/HLFIR/maxloc.f90
+++ b/flang/test/Lower/HLFIR/maxloc.f90
@@ -341,8 +341,8 @@ end subroutine test_unknown_char_len_result
 ! CHECK-DAG:       %[[C1_7:.*]] = arith.constant 1 : index
 ! CHECK-DAG:       %[[C3_8:.*]] = arith.constant 3 : index
 ! CHECK-DAG:       %[[C3_9:.*]] = arith.constant 3 : index
-! CHECK-DAG:       %[[ARRAY_BOX:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]]
-! CHECK:           %[[EXPR:.*]] = hlfir.maxloc %[[ARRAY_BOX]] {fastmath = #arith.fastmath<contract>} : (!fir.box<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<2xi32>
+! CHECK-DAG:       %[[ARRAY_REF:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref<!fir.array<3x3x!fir.char<1,3>>>
+! CHECK:           %[[EXPR:.*]] = hlfir.maxloc %[[ARRAY_REF]] {fastmath = #arith.fastmath<contract>} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<2xi32>
 ! CHECK-NEXT:      hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<2xi32>, !fir.ref<!fir.array<2xi32>>
 ! CHECK-NEXT:      hlfir.destroy %[[EXPR]]
 ! CHECK-NEXT:      return
diff --git a/flang/test/Lower/HLFIR/maxval.f90 b/flang/test/Lower/HLFIR/maxval.f90
index 5adad28..32e1a80 100644
--- a/flang/test/Lower/HLFIR/maxval.f90
+++ b/flang/test/Lower/HLFIR/maxval.f90
@@ -254,8 +254,8 @@ end subroutine test_unknown_char_len_result
 ! CHECK-DAG:       %[[C1_7:.*]] = arith.constant 1 : index
 ! CHECK-DAG:       %[[C3_8:.*]] = arith.constant 3 : index
 ! CHECK-DAG:       %[[C3_9:.*]] = arith.constant 3 : index
-! CHECK-DAG:       %[[ARRAY_BOX:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]]
-! CHECK:           %[[EXPR:.*]] = hlfir.maxval %[[ARRAY_BOX]] {fastmath = #arith.fastmath<contract>} : (!fir.box<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<!fir.char<1,3>>
+! CHECK-DAG:       %[[ARRAY_REF:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref<!fir.array<3x3x!fir.char<1,3>>>
+! CHECK:           %[[EXPR:.*]] = hlfir.maxval %[[ARRAY_REF]] {fastmath = #arith.fastmath<contract>} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<!fir.char<1,3>>
 ! CHECK-NEXT:      hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>
 ! CHECK-NEXT:      hlfir.destroy %[[EXPR]]
 ! CHECK-NEXT:      return
diff --git a/flang/test/Lower/HLFIR/minloc.f90 b/flang/test/Lower/HLFIR/minloc.f90
index f835cf5..ce149ff 100644
--- a/flang/test/Lower/HLFIR/minloc.f90
+++ b/flang/test/Lower/HLFIR/minloc.f90
@@ -341,8 +341,8 @@ end subroutine test_unknown_char_len_result
 ! CHECK-DAG:       %[[C1_7:.*]] = arith.constant 1 : index
 ! CHECK-DAG:       %[[C3_8:.*]] = arith.constant 3 : index
 ! CHECK-DAG:       %[[C3_9:.*]] = arith.constant 3 : index
-! CHECK-DAG:       %[[ARRAY_BOX:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]]
-! CHECK:           %[[EXPR:.*]] = hlfir.minloc %[[ARRAY_BOX]] {fastmath = #arith.fastmath<contract>} : (!fir.box<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<2xi32>
+! CHECK-DAG:       %[[ARRAY_REF:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref<!fir.array<3x3x!fir.char<1,3>>>
+! CHECK:           %[[EXPR:.*]] = hlfir.minloc %[[ARRAY_REF]] {fastmath = #arith.fastmath<contract>} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<2xi32>
 ! CHECK-NEXT:      hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<2xi32>, !fir.ref<!fir.array<2xi32>>
 ! CHECK-NEXT:      hlfir.destroy %[[EXPR]]
 ! CHECK-NEXT:      return
diff --git a/flang/test/Lower/HLFIR/minval.f90 b/flang/test/Lower/HLFIR/minval.f90
index 01b0ce7..2ac9aba 100644
--- a/flang/test/Lower/HLFIR/minval.f90
+++ b/flang/test/Lower/HLFIR/minval.f90
@@ -254,8 +254,8 @@ end subroutine test_unknown_char_len_result
 ! CHECK-DAG:       %[[C1_7:.*]] = arith.constant 1 : index
 ! CHECK-DAG:       %[[C3_8:.*]] = arith.constant 3 : index
 ! CHECK-DAG:       %[[C3_9:.*]] = arith.constant 3 : index
-! CHECK-DAG:       %[[ARRAY_BOX:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]]
-! CHECK:           %[[EXPR:.*]] = hlfir.minval %[[ARRAY_BOX]] {fastmath = #arith.fastmath<contract>} : (!fir.box<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<!fir.char<1,3>>
+! CHECK-DAG:       %[[ARRAY_REF:.*]] = hlfir.designate %[[ARRAY]]#0 (%[[C1]]:%[[C3_0]]:%[[C1_3]], %[[C1]]:%[[C3_1]]:%[[C1_5]]) substr %[[C1_7]], %[[C3_8]]  shape %[[SHAPE]] typeparams %[[C3_9]] : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref<!fir.array<3x3x!fir.char<1,3>>>
+! CHECK:           %[[EXPR:.*]] = hlfir.minval %[[ARRAY_REF]] {fastmath = #arith.fastmath<contract>} : (!fir.ref<!fir.array<3x3x!fir.char<1,3>>>) -> !hlfir.expr<!fir.char<1,3>>
 ! CHECK-NEXT:      hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<!fir.char<1,3>>, !fir.ref<!fir.char<1,3>>
 ! CHECK-NEXT:      hlfir.destroy %[[EXPR]]
 ! CHECK-NEXT:      return