[flang] Fixed IsContiguous check for slices of parameter arrays.

[vzakhari]

Summary

A section of a parameter array may be non-contiguous,
so the current !IsVariable(expr) check is too optimistic
to claim contiguity.

This patch fixes issues with incorrect hlfir.designate op generated
during lowering: the lowering queries IsContiguous to decide whether
to use fir.box<fir.array> or plain fir.ref<fir.array> to represent
the designator result.

[klausler]

Could you also please add a test to flang/test/Evaluate to check contiguity on named constants? That would be easier to debug if/when it breaks in the future. Just something like logical, parameter :: test_1 = is_contiguous(a(:,1)); logical, parameter :: test_2 = .not. is_contiguous(a(1,:)) would do it, I think.

[vzakhari]

In D156494#4540856, @klausler wrote:

Could you also please add a test to flang/test/Evaluate to check contiguity on named constants? That would be easier to debug if/when it breaks in the future. Just something like logical, parameter :: test_1 = is_contiguous(a(:,1)); logical, parameter :: test_2 = .not. is_contiguous(a(1,:)) would do it, I think.

Thanks! Good idea. I tried adding this:

    integer, parameter :: cst(2,2) = reshape([1, 2, 3, 4], [2, 2])
    integer :: n
    logical, parameter :: test_param1 = is_contiguous(cst(:,1))
    logical, parameter :: test_param2 = is_contiguous(cst(1,:))
    logical, parameter :: test_param3 = is_contiguous(cst(:,n))
!    logical, parameter :: test_param4 = .not. is_contiguous(cst(n,:))

The last one does not work because of error: Must be a constant value for .not. is_contiguous(cst(n,:)). The test_param2 test looks okay to me, because of the constant folding. Do you have any suggestions how to make test_param4 check work?

[klausler]

In D156494#4540903, @vzakhari wrote:

In D156494#4540856, @klausler wrote:

Could you also please add a test to flang/test/Evaluate to check contiguity on named constants? That would be easier to debug if/when it breaks in the future. Just something like logical, parameter :: test_1 = is_contiguous(a(:,1)); logical, parameter :: test_2 = .not. is_contiguous(a(1,:)) would do it, I think.

Thanks! Good idea. I tried adding this:

    integer, parameter :: cst(2,2) = reshape([1, 2, 3, 4], [2, 2])
    integer :: n
    logical, parameter :: test_param1 = is_contiguous(cst(:,1))
    logical, parameter :: test_param2 = is_contiguous(cst(1,:))
    logical, parameter :: test_param3 = is_contiguous(cst(:,n))
!    logical, parameter :: test_param4 = .not. is_contiguous(cst(n,:))

The last one does not work because of error: Must be a constant value for .not. is_contiguous(cst(n,:)). The test_param2 test looks okay to me, because of the constant folding. Do you have any suggestions how to make test_param4 check work?

The internal implementation of IS_CONTIGUOUS returns a tristate std::optional<bool> that is populated only when the predicate is definitely true or false. It must have returned a std::nullopt here for test_param4, don't know why.

[vzakhari]

Ok, let me debug this a little bit more.

[vzakhari]

• Made response about array section non-contiguity more precise.

[klausler]

flang/lib/Evaluate/check-expression.cpp

870

You don't need to use GetPtrFromOptional here, just use a & reference: if (const auto &lb{baseLbounds->at(j)}) { ... }. Same with the upper bound.

flang/test/Evaluate/folding09.f90

20

Minor point: Instead of repeating the shape of the named constant as an argument to reshape, you can write shape(cst).

25

Should this be .not. is_contiguous(cst(1,:))?

[vzakhari]

flang/lib/Evaluate/check-expression.cpp

870

Thanks! I will do this.

flang/test/Evaluate/folding09.f90

20

Thanks!

25

is_contiguous returns true for this case. I think this happens because cst(1,:) is folded into a contiguous constant. This case is not hitting the CheckSubscripts code.

[klausler]

flang/test/Evaluate/folding09.f90

25

But then cst(n,:) should also be a folded contiguous constant, no?

I would recommend not using named constants for this test, just local arrays. Also, these "test_..." variables have to be top-level module variables for the magic in test_folding.py to see them.

[vzakhari]

flang/test/Evaluate/folding09.f90

25

cst(n,:) cannot be folded, because of unknown n. The initial problem is that is_contiguous(cst(n,:)) was reporting true.

I will move the variables to the top-level, but I would like to keep using named constants because this is what my changes are about.

[klausler]

flang/test/Evaluate/folding09.f90

25

Ok. It would be a good idea to compare your results with other compilers here.

One could make a case that is_contiguous(cst(n,:)) should be true, since cst(n,:) is not a variable.

[klausler]

For

subroutine subr(n)
  integer, intent(in) :: n
  real, parameter :: c(2,2) = reshape([1.,2.,3.,4.],shape(c))
  print *, is_contiguous(c(:,1))
  print *, is_contiguous(c(1,:))
  print *, is_contiguous(c(:,n))
  print *, is_contiguous(c(n,:))
end

call subr(1)
end

all compilers agree that is_contiguous(c(:,1)) and is_contiguous(c(:,n)) are true, and that is_contiguous(c(n,:)) is false. They are inconsistent on the case of is_contiguous(c(1,:)).

[vzakhari]

I tried this case:

module m
  integer, parameter :: cst(2,2) = reshape([1, 2, 3, 4], [2, 2])
 contains
  subroutine test(n)
    integer :: n
    print *, is_contiguous(cst(n,:))
  end subroutine
end module

program main
  use m
  call test(1)
end program main

gfortran/ifx/ifort/xlf print F
nvfortran prints T

[vzakhari]

In D156494#4551527, @klausler wrote:

For

subroutine subr(n)
  integer, intent(in) :: n
  real, parameter :: c(2,2) = reshape([1.,2.,3.,4.],shape(c))
  print *, is_contiguous(c(:,1))
  print *, is_contiguous(c(1,:))
  print *, is_contiguous(c(:,n))
  print *, is_contiguous(c(n,:))
end

call subr(1)
end

all compilers agree that is_contiguous(c(:,1)) and is_contiguous(c(:,n)) are true, and that is_contiguous(c(n,:)) is false. They are inconsistent on the case of is_contiguous(c(1,:)).

Right, c(1,:) contiguity depends on whether it is represented with a separate constant object holding the copy of c(1,:) or it is represented as an array section of the original constant object c. I am not sure if it makes sense from the Fortran standard point of view, but it makes sense to me from the implementation point of view that chooses the final memory layout of the data.

[vzakhari]

• Addressed comments.

flang/lib/Evaluate/check-expression.cpp

 class IsContiguousHelper
     : public AnyTraverse<IsContiguousHelper, std::optional<bool>> {
 public:
   using Result = std::optional<bool>; // tri-state
   using Base = AnyTraverse<IsContiguousHelper, Result>;
   explicit IsContiguousHelper(FoldingContext &c) : Base{*this}, context_{c} {}
   using Base::operator();
 
+  template <typename T> Result operator()(const Constant<T> &) const {
+    return true;
+  }
+  Result operator()(const StaticDataObject &) const { return true; }
   Result operator()(const semantics::Symbol &symbol) const {
     const auto &ultimate{symbol.GetUltimate()};
     if (ultimate.attrs().test(semantics::Attr::CONTIGUOUS)) {
       return true;
+    } else if (!IsVariable(symbol)) {
+      return true;
     } else if (ultimate.Rank() == 0) {
       // Extension: accept scalars as a degenerate case of
       // simple contiguity to allow their use in contexts like
       // data targets in pointer assignments with remapping.
       return true;
     } else if (ultimate.has<semantics::AssocEntityDetails>()) {
       return Base::operator()(ultimate); // use expr
     } else if (semantics::IsPointer(ultimate) ||
private:
   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;) {
+    bool mayBeEmpty{false};
+    auto dims{subscript.size()};
+    std::vector<bool> knownPartialSlice(dims, false);
+    for (auto j{dims}; j-- > 0;) {
+      std::optional<ConstantSubscript> dimLbound;
+      std::optional<ConstantSubscript> dimUbound;
+      std::optional<ConstantSubscript> dimExtent;
+      if (baseLbounds && j < baseLbounds->size()) {
+        if (const auto &lb{baseLbounds->at(j)}) {
+          dimLbound = ToInt64(Fold(context_, Expr<SubscriptInteger>{*lb}));
+        }
+      }
+      if (baseUbounds && j < baseUbounds->size()) {
+        if (const auto &ub{baseUbounds->at(j)}) {
+          dimUbound = ToInt64(Fold(context_, Expr<SubscriptInteger>{*ub}));
+        }
+      }
+      if (dimLbound && dimUbound) {
+        if (*dimLbound <= *dimUbound) {
+          dimExtent = *dimUbound - *dimLbound + 1;
+        } else {
+          // This is an empty dimension.
+          result = true;
+          dimExtent = 0;
+        }
+      }
+
       if (const auto *triplet{std::get_if<Triplet>(&subscript[j].u)}) {
         ++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};
+                  : dimLbound};
           std::optional<ConstantSubscript> upperVal{upperBound
                   ? ToInt64(Fold(context_, Expr<SubscriptInteger>{*upperBound}))
-                  : std::nullopt};
+                  : dimUbound};
           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 {
+              mayBeEmpty = true;
             }
+          } else {
+            mayBeEmpty = true;
           }
+        } else {
+          mayBeEmpty = true;
         }
       } else if (subscript[j].Rank() > 0) {
         ++rank;
         if (!result) {
           result = false; // vector subscript
         }
+        mayBeEmpty = true;
+      } else {
+        // Scalar subscript.
+        if (dimExtent && *dimExtent > 1) {
+          knownPartialSlice[j] = true;
+        }
       }
     }
     if (rank == 0) {
       result = true; // scalar
     }
     if (result) {
       return result;
     }
for (auto j{subscript.size()}; j-- > 0;) {
             // simple contiguity
             return std::nullopt;
           }
         } else {
           anyTriplet = true;
         }
         ++rank;
       } else if (anyTriplet) {
-        return std::nullopt;
+        // If the section cannot be empty, and this dimension's
+        // scalar subscript is known not to cover the whole
+        // dimension, then the array section is provably
+        // discontiguous.
+        return (mayBeEmpty || !knownPartialSlice[j])
+            ? std::nullopt
+            : std::make_optional(false);
       }
     }
     return true; // simply contiguous
   }
 
   FoldingContext &context_;
 };
 
 template <typename A>
 std::optional<bool> IsContiguous(const A &x, FoldingContext &context) {
-  if (IsVariable(x)) {
-    return IsContiguousHelper{context}(x);
-  } else {
-    return true; // not a variable
-  }
 }
 
 template std::optional<bool> IsContiguous(
     const Expr<SomeType> &, FoldingContext &);
 template std::optional<bool> IsContiguous(const ArrayRef &, FoldingContext &);
 template std::optional<bool> IsContiguous(const Substring &, FoldingContext &);
 template std::optional<bool> IsContiguous(const Component &, FoldingContext &);
 template std::optional<bool> IsContiguous(

flang/test/Evaluate/folding09.f90

 ! RUN: %python %S/test_folding.py %s %flang_fc1
 ! Test folding of IS_CONTIGUOUS
 
 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
+  logical, parameter :: test_param1 = is_contiguous(cst(:,1))
+  logical, parameter :: test_param2 = is_contiguous(cst(1,:))
+  logical, parameter :: test_param3 = is_contiguous(cst(:,n))
+  logical, parameter :: test_param4 = .not. is_contiguous(cst(n,:))
+  logical, parameter :: test_param5 = is_contiguous(empty_cst(n,-1:n:2))
  contains
   function f()
     real, pointer, contiguous :: f(:)
     f => hosted
   end function
   subroutine test(arr1, arr2, arr3, mat, alloc)
     real, intent(in) :: arr1(:), arr2(10), mat(10, 10)
     real, intent(in), contiguous :: arr3(:)
     real, allocatable :: alloc(:)
     real :: scalar
     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
     integer(kind=merge(1,-1,       is_contiguous([0, 1, 2])))       t04
     integer(kind=merge(1,-1,       is_contiguous(arr1 + 1.0)))      t05
     integer(kind=merge(1,-1,       is_contiguous(arr2)))            t06
     integer(kind=merge(1,-1,       is_contiguous(mat)))             t07
     integer(kind=merge(1,-1,       is_contiguous(mat(1:10,1))))     t08
     integer(kind=merge(1,-1,       is_contiguous(arr2(1:10:1))))    t09
     integer(kind=merge(1,-1, .not. is_contiguous(arr2(1:10:2))))    t10

flang/test/Lower/HLFIR/designators-parameter-array-slice.f90

+! Test non-contiguous slice of parameter array.
+! RUN: bbc -emit-hlfir --polymorphic-type -o - %s | FileCheck %s
+subroutine test2(i)
+  integer, parameter :: a(*,*) = reshape( [ 1,2,3,4 ], [ 2,2 ])
+  integer :: x(2)
+  x = a(i,:)
+end subroutine test2
+! Check that the result type of the designate operation
+! is a box (as opposed to !fir.ref<!fir.array<>>) that is able
+! to represent non-contiguous array section:
+! CHECK: hlfir.designate {{.*}} shape {{.*}} : (!fir.ref<!fir.array<2x2xi32>>, i64, index, index, index, !fir.shape<1>) -> !fir.box<!fir.array<2xi32>>