diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h index 2bf286f000ffa..246f346dcc327 100644 --- a/flang/include/flang/Evaluate/shape.h +++ b/flang/include/flang/Evaluate/shape.h @@ -68,14 +68,18 @@ template std::optional GetShape(const A &); // in its scope, and it will not have been forced to 1 on an empty dimension. // GetLBOUND()'s result is safer, but it is optional because it does fail // in those circumstances. +// Similarly, GetUBOUND result will be forced to 0 on an empty dimension, +// but will fail if the extent is not a compile time constant. ExtentExpr GetRawLowerBound(const NamedEntity &, int dimension); ExtentExpr GetRawLowerBound( FoldingContext &, const NamedEntity &, int dimension); MaybeExtentExpr GetLBOUND(const NamedEntity &, int dimension); MaybeExtentExpr GetLBOUND(FoldingContext &, const NamedEntity &, int dimension); -MaybeExtentExpr GetUpperBound(const NamedEntity &, int dimension); -MaybeExtentExpr GetUpperBound( +MaybeExtentExpr GetRawUpperBound(const NamedEntity &, int dimension); +MaybeExtentExpr GetRawUpperBound( FoldingContext &, const NamedEntity &, int dimension); +MaybeExtentExpr GetUBOUND(const NamedEntity &, int dimension); +MaybeExtentExpr GetUBOUND(FoldingContext &, const NamedEntity &, int dimension); MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent); MaybeExtentExpr ComputeUpperBound( FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent); @@ -83,8 +87,8 @@ Shape GetRawLowerBounds(const NamedEntity &); Shape GetRawLowerBounds(FoldingContext &, const NamedEntity &); Shape GetLBOUNDs(const NamedEntity &); Shape GetLBOUNDs(FoldingContext &, const NamedEntity &); -Shape GetUpperBounds(const NamedEntity &); -Shape GetUpperBounds(FoldingContext &, const NamedEntity &); +Shape GetUBOUNDs(const NamedEntity &); +Shape GetUBOUNDs(FoldingContext &, const NamedEntity &); MaybeExtentExpr GetExtent(const NamedEntity &, int dimension); MaybeExtentExpr GetExtent(FoldingContext &, const NamedEntity &, int dimension); MaybeExtentExpr GetExtent( diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp index c780b51d7270a..bdff5f20892d4 100644 --- a/flang/lib/Evaluate/check-expression.cpp +++ b/flang/lib/Evaluate/check-expression.cpp @@ -124,7 +124,7 @@ bool IsConstantExprHelper::operator()( } else if (intrinsic->name == "ubound" && call.arguments().size() == 1) { // UBOUND(x) without DIM= auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())}; - return base && IsConstantExprShape(GetUpperBounds(*base)); + return base && IsConstantExprShape(GetUBOUNDs(*base)); } else if (intrinsic->name == "shape") { auto shape{GetShape(call.arguments()[0]->UnwrapExpr())}; return shape && IsConstantExprShape(*shape); diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp index 8dcb7c093469b..ff2504e971ff7 100644 --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -140,11 +140,11 @@ Expr> UBOUND(FoldingContext &context, "rank-%d assumed-size array"_err_en_US, rank, rank); return MakeInvalidIntrinsic(std::move(funcRef)); - } else if (auto ub{GetUpperBound(context, *named, *dim)}) { + } else if (auto ub{GetUBOUND(context, *named, *dim)}) { return Fold(context, ConvertToType(std::move(*ub))); } } else { - Shape ubounds{GetUpperBounds(context, *named)}; + Shape ubounds{GetUBOUNDs(context, *named)}; if (semantics::IsAssumedSizeArray(symbol)) { CHECK(!ubounds.back()); ubounds.back() = ExtentExpr{-1}; diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp index e8caf47abfd8d..1a2f171e5ba86 100644 --- a/flang/lib/Evaluate/shape.cpp +++ b/flang/lib/Evaluate/shape.cpp @@ -272,10 +272,24 @@ class GetLowerBoundHelper auto extent{ToInt64(Fold(*context_, ExtentExpr{*ubound} - ExtentExpr{*lbound} + ExtentExpr{1}))}; - ok = extent && *extent > 0; + if (extent) { + if (extent <= 0) { + return Result{1}; + } + ok = true; + } else { + ok = false; + } } else { auto ubValue{ToInt64(*ubound)}; - ok = lbValue && ubValue && *lbValue <= *ubValue; + if (lbValue && ubValue) { + if (*lbValue > *ubValue) { + return Result{1}; + } + ok = true; + } else { + ok = false; + } } } return ok ? *lbound : Result{}; @@ -466,7 +480,7 @@ MaybeExtentExpr GetExtent( [&](const Triplet &triplet) -> MaybeExtentExpr { MaybeExtentExpr upper{triplet.upper()}; if (!upper) { - upper = GetUpperBound(base, dimension); + upper = GetUBOUND(base, dimension); } MaybeExtentExpr lower{triplet.lower()}; if (!lower) { @@ -511,22 +525,71 @@ MaybeExtentExpr ComputeUpperBound( return Fold(context, ComputeUpperBound(std::move(lower), std::move(extent))); } -MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) { +MaybeExtentExpr GetRawUpperBound(const NamedEntity &base, int dimension) { const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())}; if (const auto *details{symbol.detailsIf()}) { - int j{0}; - for (const auto &shapeSpec : details->shape()) { - if (j++ == dimension) { - const auto &bound{shapeSpec.ubound().GetExplicit()}; - if (bound && IsScopeInvariantExpr(*bound)) { - return *bound; - } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) { - break; - } else if (auto lb{GetLBOUND(base, dimension)}) { - return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension)); + int rank{details->shape().Rank()}; + if (dimension < rank) { + const auto &bound{details->shape()[dimension].ubound().GetExplicit()}; + if (bound && IsScopeInvariantExpr(*bound)) { + return *bound; + } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) { + return std::nullopt; + } else { + return ComputeUpperBound( + GetRawLowerBound(base, dimension), GetExtent(base, dimension)); + } + } + } else if (const auto *assoc{ + symbol.detailsIf()}) { + if (auto shape{GetShape(assoc->expr())}) { + if (dimension < static_cast(shape->size())) { + return ComputeUpperBound( + GetRawLowerBound(base, dimension), std::move(shape->at(dimension))); + } + } + } + return std::nullopt; +} + +MaybeExtentExpr GetRawUpperBound( + FoldingContext &context, const NamedEntity &base, int dimension) { + return Fold(context, GetRawUpperBound(base, dimension)); +} + +static MaybeExtentExpr GetExplicitUBOUND( + FoldingContext *context, const semantics::ShapeSpec &shapeSpec) { + const auto &ubound{shapeSpec.ubound().GetExplicit()}; + if (ubound && IsScopeInvariantExpr(*ubound)) { + if (auto extent{GetNonNegativeExtent(shapeSpec)}) { + if (auto cstExtent{ToInt64( + context ? Fold(*context, std::move(*extent)) : *extent)}) { + if (cstExtent > 0) { + return *ubound; + } else if (cstExtent == 0) { + return ExtentExpr{0}; } } } + } + return std::nullopt; +} + +static MaybeExtentExpr GetUBOUND( + FoldingContext *context, const NamedEntity &base, int dimension) { + const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())}; + if (const auto *details{symbol.detailsIf()}) { + int rank{details->shape().Rank()}; + if (dimension < rank) { + const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]}; + if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) { + return *ubound; + } else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) { + return std::nullopt; + } else if (auto lb{GetLBOUND(base, dimension)}) { + return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension)); + } + } } else if (const auto *assoc{ symbol.detailsIf()}) { if (auto shape{GetShape(assoc->expr())}) { @@ -541,20 +604,23 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) { return std::nullopt; } -MaybeExtentExpr GetUpperBound( +MaybeExtentExpr GetUBOUND(const NamedEntity &base, int dimension) { + return GetUBOUND(nullptr, base, dimension); +} + +MaybeExtentExpr GetUBOUND( FoldingContext &context, const NamedEntity &base, int dimension) { - return Fold(context, GetUpperBound(base, dimension)); + return Fold(context, GetUBOUND(&context, base, dimension)); } -Shape GetUpperBounds(const NamedEntity &base) { +static Shape GetUBOUNDs(FoldingContext *context, const NamedEntity &base) { const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())}; if (const auto *details{symbol.detailsIf()}) { Shape result; int dim{0}; for (const auto &shapeSpec : details->shape()) { - const auto &bound{shapeSpec.ubound().GetExplicit()}; - if (bound && IsScopeInvariantExpr(*bound)) { - result.push_back(*bound); + if (auto ubound{GetExplicitUBOUND(context, shapeSpec)}) { + result.emplace_back(*ubound); } else if (details->IsAssumedSize() && dim + 1 == base.Rank()) { result.emplace_back(std::nullopt); // UBOUND folding replaces with -1 } else if (auto lb{GetLBOUND(base, dim)}) { @@ -572,10 +638,12 @@ Shape GetUpperBounds(const NamedEntity &base) { } } -Shape GetUpperBounds(FoldingContext &context, const NamedEntity &base) { - return Fold(context, GetUpperBounds(base)); +Shape GetUBOUNDs(FoldingContext &context, const NamedEntity &base) { + return Fold(context, GetUBOUNDs(&context, base)); } +Shape GetUBOUNDs(const NamedEntity &base) { return GetUBOUNDs(nullptr, base); } + auto GetShapeHelper::operator()(const Symbol &symbol) const -> Result { return std::visit( common::visitors{ diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp index 477ac78468133..007567ff83f28 100644 --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -799,7 +799,7 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent( evaluate::GetRawLowerBound(foldingContext, entity, j)), parameters)); bounds.emplace_back(GetValue( - evaluate::GetUpperBound(foldingContext, entity, j), parameters)); + evaluate::GetRawUpperBound(foldingContext, entity, j), parameters)); } AddValue(values, componentSchema_, "bounds"s, SaveDerivedPointerTarget(scope, diff --git a/flang/test/Evaluate/folding08.f90 b/flang/test/Evaluate/folding08.f90 index f00ec873a0324..7432cbd86fb08 100644 --- a/flang/test/Evaluate/folding08.f90 +++ b/flang/test/Evaluate/folding08.f90 @@ -3,6 +3,7 @@ module m real :: a3(42:52) + real :: empty(52:42, 2:3, 10:1) integer, parameter :: lba3(*) = lbound(a3) logical, parameter :: test_lba3 = all(lba3 == [42]) type :: t @@ -38,6 +39,13 @@ module m logical, parameter :: test_lbfoo = all(lbfoo == [1,1]) integer, parameter :: ubfoo(*) = ubound(foo()) logical, parameter :: test_ubfoo = all(ubfoo == [2,3]) + + integer, parameter :: lbs_empty(*) = lbound(empty) + logical, parameter :: test_lbs_empty = all(lbs_empty == [1, 2, 1]) + integer, parameter :: ubs_empty(*) = ubound(empty) + logical, parameter :: test_ubs_empty = all(ubs_empty == [0, 3, 0]) + logical, parameter :: test_lb_empty_dim = lbound(empty, 1) == 1 + logical, parameter :: test_ub_empty_dim = ubound(empty, 1) == 0 contains function foo() real :: foo(2:3,4:6) diff --git a/flang/test/Evaluate/rewrite01.f90 b/flang/test/Evaluate/rewrite01.f90 index 1627dc62c1b9d..a752905856511 100644 --- a/flang/test/Evaluate/rewrite01.f90 +++ b/flang/test/Evaluate/rewrite01.f90 @@ -25,6 +25,7 @@ function returns_array_3() subroutine ubound_test(x, n, m) integer :: x(n, m) + integer :: y(0:n, 0:m) ! UBOUND could be 0 if n or m are < 0 !CHECK: PRINT *, [INTEGER(4)::int(size(x,dim=1),kind=4),int(size(x,dim=2),kind=4)] print *, ubound(x) !CHECK: PRINT *, ubound(returns_array(n,m)) @@ -35,6 +36,10 @@ subroutine ubound_test(x, n, m) print *, ubound(returns_array_2(m)) !CHECK: PRINT *, 42_8 print *, ubound(returns_array_3(), dim=1, kind=8) + !CHECK: PRINT *, ubound(y) + print *, ubound(y) + !CHECK: PRINT *, ubound(y,1_4) + print *, ubound(y, 1) end subroutine subroutine size_test(x, n, m) @@ -65,6 +70,7 @@ subroutine shape_test(x, n, m) subroutine lbound_test(x, n, m) integer :: x(n, m) + integer :: y(0:n, 0:m) ! LBOUND could be 1 if n or m are < 0 !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] print *, lbound(x) !CHECK: PRINT *, [INTEGER(4)::1_4,1_4] @@ -75,6 +81,10 @@ subroutine lbound_test(x, n, m) print *, lbound(returns_array_2(m), dim=1) !CHECK: PRINT *, 1_4 print *, lbound(returns_array_3(), dim=1) + !CHECK: PRINT *, lbound(y) + print *, lbound(y) + !CHECK: PRINT *, lbound(y,1_4) + print *, lbound(y, 1) end subroutine !CHECK: len_test