diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index 38794a2d8aacc..998378c44cdf4 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -908,7 +908,58 @@ class IsContiguousHelper 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())}; + std::optional 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 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(*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 863b5e873a1e5..534ff1a89a174 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 @@ function f() 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 @@ subroutine test(arr1, arr2, arr3, mat, alloc) 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 166a1b9db1724..539affad2d7df 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} : (!fir.box>>) -> !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>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref>> +! CHECK: %[[EXPR:.*]] = hlfir.maxloc %[[ARRAY_REF]] {fastmath = #arith.fastmath} : (!fir.ref>>) -> !hlfir.expr<2xi32> ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! 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 5adad286a77d2..32e1a80417a27 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} : (!fir.box>>) -> !hlfir.expr> +! 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>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref>> +! CHECK: %[[EXPR:.*]] = hlfir.maxval %[[ARRAY_REF]] {fastmath = #arith.fastmath} : (!fir.ref>>) -> !hlfir.expr> ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr>, !fir.ref> ! 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 f835cf54b2a73..ce149ffcfb54f 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} : (!fir.box>>) -> !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>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref>> +! CHECK: %[[EXPR:.*]] = hlfir.minloc %[[ARRAY_REF]] {fastmath = #arith.fastmath} : (!fir.ref>>) -> !hlfir.expr<2xi32> ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr<2xi32>, !fir.ref> ! 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 01b0ce77e2d30..2ac9aba850b6f 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} : (!fir.box>>) -> !hlfir.expr> +! 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>>, index, index, index, index, index, index, index, index, !fir.shape<2>, index) -> !fir.ref>> +! CHECK: %[[EXPR:.*]] = hlfir.minval %[[ARRAY_REF]] {fastmath = #arith.fastmath} : (!fir.ref>>) -> !hlfir.expr> ! CHECK-NEXT: hlfir.assign %[[EXPR]] to %[[RES]]#0 : !hlfir.expr>, !fir.ref> ! CHECK-NEXT: hlfir.destroy %[[EXPR]] ! CHECK-NEXT: return