// 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);
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(
} 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);
"rank-%d assumed-size array"_err_en_US,
rank, rank);
return MakeInvalidIntrinsic<T>(std::move(funcRef));
- } else if (auto ub{GetUpperBound(context, *named, *dim)}) {
+ } else if (auto ub{GetUBOUND(context, *named, *dim)}) {
return Fold(context, ConvertToType<T>(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};
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{};
[&](const Triplet &triplet) -> MaybeExtentExpr {
MaybeExtentExpr upper{triplet.upper()};
if (!upper) {
- upper = GetUpperBound(base, dimension);
+ upper = GetUBOUND(base, dimension);
}
MaybeExtentExpr lower{triplet.lower()};
if (!lower) {
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<semantics::ObjectEntityDetails>()}) {
- 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<semantics::AssocEntityDetails>()}) {
+ if (auto shape{GetShape(assoc->expr())}) {
+ if (dimension < static_cast<int>(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<semantics::ObjectEntityDetails>()}) {
+ 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<semantics::AssocEntityDetails>()}) {
if (auto shape{GetShape(assoc->expr())}) {
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<semantics::ObjectEntityDetails>()}) {
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)}) {
}
}
-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{
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,
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
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)
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))
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)
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]
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