diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -174,7 +174,6 @@ Triplet &set_stride(Expr &&); bool operator==(const Triplet &) const; - std::optional IsStrideOne() const; llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const; private: diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -699,7 +699,10 @@ 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) { @@ -745,17 +748,75 @@ Result operator()(const NullPointer &) const { return true; } private: - static std::optional CheckSubscripts( - const std::vector &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 CheckSubscripts(const std::vector &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 result; for (auto j{subscript.size()}; j-- > 0;) { if (const auto *triplet{std::get_if(&subscript[j].u)}) { - auto isStride1{triplet->IsStrideOne()}; - if (!isStride1.value_or(false)) { - return isStride1; + ++rank; + if (auto stride{ToInt64(triplet->stride())}) { + const Expr *lowerBound{triplet->GetLower()}; + if (!lowerBound && baseLbounds && j < baseLbounds->size()) { + lowerBound = common::GetPtrFromOptional(baseLbounds->at(j)); + } + const Expr *upperBound{triplet->GetUpper()}; + if (!upperBound && baseUbounds && j < baseUbounds->size()) { + upperBound = common::GetPtrFromOptional(baseUbounds->at(j)); + } + std::optional lowerVal{lowerBound + ? ToInt64(Fold(context_, Expr{*lowerBound})) + : std::nullopt}; + std::optional upperVal{upperBound + ? ToInt64(Fold(context_, Expr{*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(&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; @@ -764,11 +825,11 @@ 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_; diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -69,14 +69,6 @@ return *this; } -std::optional Triplet::IsStrideOne() const { - if (auto stride{ToInt64(stride_.value())}) { - return stride == 1; - } else { - return std::nullopt; - } -} - CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector &&ss, std::vector> &&css) : base_{std::move(base)}, subscript_(std::move(ss)), diff --git a/flang/test/Semantics/assign03.f90 b/flang/test/Semantics/assign03.f90 --- a/flang/test/Semantics/assign03.f90 +++ b/flang/test/Semantics/assign03.f90 @@ -294,6 +294,12 @@ 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(..)