[flang-commits] [flang] 3b61587 - [flang] LBOUND() edge case: empty dimension
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Mar 14 11:16:19 PDT 2022
Author: Peter Klausler
Date: 2022-03-14T11:16:09-07:00
New Revision: 3b61587c9e27747438a0364f8b8cf19273142452
URL: https://github.com/llvm/llvm-project/commit/3b61587c9e27747438a0364f8b8cf19273142452
DIFF: https://github.com/llvm/llvm-project/commit/3b61587c9e27747438a0364f8b8cf19273142452.diff
LOG: [flang] LBOUND() edge case: empty dimension
LBOUND must return 1 for an empty dimension, no matter what
explicit expression might appear in a declaration or arrive in
a descriptor.
Differential Revision: https://reviews.llvm.org/D121488
Added:
Modified:
flang/docs/Extensions.md
flang/include/flang/Evaluate/shape.h
flang/include/flang/Runtime/descriptor.h
flang/lib/Evaluate/check-expression.cpp
flang/lib/Evaluate/constant.cpp
flang/lib/Evaluate/fold-designator.cpp
flang/lib/Evaluate/fold-integer.cpp
flang/lib/Evaluate/fold.cpp
flang/lib/Evaluate/shape.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/runtime/ISO_Fortran_binding.cpp
flang/runtime/pointer.cpp
flang/test/Evaluate/folding08.f90
Removed:
################################################################################
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 4a038742ddb3f..8b84045d20116 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -71,6 +71,10 @@ end
In common with some other compilers, the clock is in milliseconds
for kinds <= 4 and nanoseconds otherwise where the target system
supports these rates.
+* If a dimension of a descriptor has zero extent in a call to
+ `CFI_section`, `CFI_setpointer` or `CFI_allocate`, the lower
+ bound on that dimension will be set to 1 for consistency with
+ the `LBOUND()` intrinsic function.
## Extensions, deletions, and legacy features supported by default
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index 29b1bafff29b6..2bf286f000ffa 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -62,16 +62,27 @@ template <typename A> std::optional<Shape> GetShape(const A &);
// The dimension argument to these inquiries is zero-based,
// unlike the DIM= arguments to many intrinsics.
-ExtentExpr GetLowerBound(const NamedEntity &, int dimension);
-ExtentExpr GetLowerBound(FoldingContext &, const NamedEntity &, int dimension);
+//
+// GetRawLowerBound() returns a lower bound expression, which may
+// not be suitable for all purposes; specifically, it might not be invariant
+// 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.
+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(
FoldingContext &, const NamedEntity &, int dimension);
MaybeExtentExpr ComputeUpperBound(ExtentExpr &&lower, MaybeExtentExpr &&extent);
MaybeExtentExpr ComputeUpperBound(
FoldingContext &, ExtentExpr &&lower, MaybeExtentExpr &&extent);
-Shape GetLowerBounds(const NamedEntity &);
-Shape GetLowerBounds(FoldingContext &, const NamedEntity &);
+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 &);
MaybeExtentExpr GetExtent(const NamedEntity &, int dimension);
diff --git a/flang/include/flang/Runtime/descriptor.h b/flang/include/flang/Runtime/descriptor.h
index 9666f9c0422a1..376d3bb95e655 100644
--- a/flang/include/flang/Runtime/descriptor.h
+++ b/flang/include/flang/Runtime/descriptor.h
@@ -50,10 +50,17 @@ class Dimension {
SubscriptValue ByteStride() const { return raw_.sm; }
Dimension &SetBounds(SubscriptValue lower, SubscriptValue upper) {
- raw_.lower_bound = lower;
- raw_.extent = upper >= lower ? upper - lower + 1 : 0;
+ if (upper >= lower) {
+ raw_.lower_bound = lower;
+ raw_.extent = upper - lower + 1;
+ } else {
+ raw_.lower_bound = 1;
+ raw_.extent = 0;
+ }
return *this;
}
+ // Do not use this API to cause the LB of an empty dimension
+ // to anything other than 1. Use SetBounds() instead if you can.
Dimension &SetLowerBound(SubscriptValue lower) {
raw_.lower_bound = lower;
return *this;
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index e4423f8c300f9..c780b51d7270a 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -120,7 +120,7 @@ bool IsConstantExprHelper<INVARIANT>::operator()(
} else if (intrinsic->name == "lbound" && call.arguments().size() == 1) {
// LBOUND(x) without DIM=
auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
- return base && IsConstantExprShape(GetLowerBounds(*base));
+ return base && IsConstantExprShape(GetLBOUNDs(*base));
} else if (intrinsic->name == "ubound" && call.arguments().size() == 1) {
// UBOUND(x) without DIM=
auto base{ExtractNamedEntity(call.arguments()[0]->UnwrapExpr())};
@@ -434,7 +434,7 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
// expand the scalar constant to an array
return ScalarConstantExpander{std::move(*extents),
AsConstantExtents(
- context, GetLowerBounds(context, NamedEntity{symbol}))}
+ context, GetRawLowerBounds(context, NamedEntity{symbol}))}
.Expand(std::move(folded));
} else if (auto resultShape{GetShape(context, folded)}) {
if (CheckConformance(context.messages(), symTS->shape(),
@@ -443,8 +443,8 @@ std::optional<Expr<SomeType>> NonPointerInitializationExpr(const Symbol &symbol,
.value_or(false /*fail if not known now to conform*/)) {
// make a constant array with adjusted lower bounds
return ArrayConstantBoundChanger{
- std::move(*AsConstantExtents(
- context, GetLowerBounds(context, NamedEntity{symbol})))}
+ std::move(*AsConstantExtents(context,
+ GetRawLowerBounds(context, NamedEntity{symbol})))}
.ChangeLbounds(std::move(folded));
}
}
diff --git a/flang/lib/Evaluate/constant.cpp b/flang/lib/Evaluate/constant.cpp
index 9f2040ce8575f..19c3c2aa913ab 100644
--- a/flang/lib/Evaluate/constant.cpp
+++ b/flang/lib/Evaluate/constant.cpp
@@ -25,6 +25,11 @@ ConstantBounds::~ConstantBounds() = default;
void ConstantBounds::set_lbounds(ConstantSubscripts &&lb) {
CHECK(lb.size() == shape_.size());
lbounds_ = std::move(lb);
+ for (std::size_t j{0}; j < shape_.size(); ++j) {
+ if (shape_[j] == 0) {
+ lbounds_[j] = 1;
+ }
+ }
}
void ConstantBounds::SetLowerBoundsToOne() {
diff --git a/flang/lib/Evaluate/fold-designator.cpp b/flang/lib/Evaluate/fold-designator.cpp
index 45ae691d4b849..f3e1cf40cb8ac 100644
--- a/flang/lib/Evaluate/fold-designator.cpp
+++ b/flang/lib/Evaluate/fold-designator.cpp
@@ -50,7 +50,7 @@ std::optional<OffsetSymbol> DesignatorFolder::FoldDesignator(
if (auto type{DynamicType::From(array)}) {
if (auto extents{GetConstantExtents(context_, array)}) {
if (auto bytes{ToInt64(type->MeasureSizeInBytes(context_, true))}) {
- Shape lbs{GetLowerBounds(context_, x.base())};
+ Shape lbs{GetLBOUNDs(context_, x.base())};
if (auto lowerBounds{AsConstantExtents(context_, lbs)}) {
std::optional<OffsetSymbol> result;
if (!x.base().IsSymbol() &&
@@ -206,7 +206,7 @@ static std::optional<ArrayRef> OffsetToArrayRef(FoldingContext &context,
NamedEntity &&entity, const Shape &shape, const DynamicType &elementType,
ConstantSubscript &offset) {
auto extents{AsConstantExtents(context, shape)};
- Shape lbs{GetLowerBounds(context, entity)};
+ Shape lbs{GetRawLowerBounds(context, entity)};
auto lower{AsConstantExtents(context, lbs)};
auto elementBytes{ToInt64(elementType.MeasureSizeInBytes(context, true))};
if (!extents || !lower || !elementBytes || *elementBytes <= 0) {
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 53dfaf240c33d..8dcb7c093469b 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -76,10 +76,11 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
if (symbol.Rank() == rank) {
lowerBoundsAreOne = false;
if (dim) {
- return Fold(context,
- ConvertToType<T>(GetLowerBound(context, *named, *dim)));
+ if (auto lb{GetLBOUND(context, *named, *dim)}) {
+ return Fold(context, ConvertToType<T>(std::move(*lb)));
+ }
} else if (auto extents{
- AsExtentArrayExpr(GetLowerBounds(context, *named))}) {
+ AsExtentArrayExpr(GetLBOUNDs(context, *named))}) {
return Fold(context,
ConvertToType<T>(Expr<ExtentType>{std::move(*extents)}));
}
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index c6397e46c48e0..f3c2e6ca1c563 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -36,12 +36,13 @@ std::optional<Constant<SubscriptInteger>> GetConstantSubscript(
auto lower{triplet.lower()}, upper{triplet.upper()};
std::optional<ConstantSubscript> stride{ToInt64(triplet.stride())};
if (!lower) {
- lower = GetLowerBound(context, base, dim);
+ lower = GetLBOUND(context, base, dim);
}
if (!upper) {
- upper =
- ComputeUpperBound(context, GetLowerBound(context, base, dim),
- GetExtent(context, base, dim));
+ if (auto lb{GetLBOUND(context, base, dim)}) {
+ upper = ComputeUpperBound(
+ context, std::move(*lb), GetExtent(context, base, dim));
+ }
}
auto lbi{ToInt64(lower)}, ubi{ToInt64(upper)};
if (lbi && ubi && stride && *stride != 0) {
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index bb5e6ea4cd376..e8caf47abfd8d 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -229,101 +229,151 @@ bool ContainsAnyImpliedDoIndex(const ExtentExpr &expr) {
// Determines lower bound on a dimension. This can be other than 1 only
// for a reference to a whole array object or component. (See LBOUND, 16.9.109).
// ASSOCIATE construct entities may require traversal of their referents.
-class GetLowerBoundHelper : public Traverse<GetLowerBoundHelper, ExtentExpr> {
+template <typename RESULT, bool LBOUND_SEMANTICS>
+class GetLowerBoundHelper
+ : public Traverse<GetLowerBoundHelper<RESULT, LBOUND_SEMANTICS>, RESULT> {
public:
- using Result = ExtentExpr;
- using Base = Traverse<GetLowerBoundHelper, ExtentExpr>;
+ using Result = RESULT;
+ using Base = Traverse<GetLowerBoundHelper, RESULT>;
using Base::operator();
- explicit GetLowerBoundHelper(int d) : Base{*this}, dimension_{d} {}
- static ExtentExpr Default() { return ExtentExpr{1}; }
- static ExtentExpr Combine(Result &&, Result &&) { return Default(); }
- ExtentExpr operator()(const Symbol &);
- ExtentExpr operator()(const Component &);
-
-private:
- int dimension_;
-};
+ explicit GetLowerBoundHelper(int d, FoldingContext *context)
+ : Base{*this}, dimension_{d}, context_{context} {}
+ static Result Default() { return Result{1}; }
+ static Result Combine(Result &&, Result &&) {
+ // Operator results and array references always have lower bounds == 1
+ return Result{1};
+ }
-auto GetLowerBoundHelper::operator()(const Symbol &symbol0) -> Result {
- const Symbol &symbol{symbol0.GetUltimate()};
- if (const auto *details{symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
- int j{0};
- for (const auto &shapeSpec : details->shape()) {
- if (j++ == dimension_) {
- const auto &bound{shapeSpec.lbound().GetExplicit()};
- if (bound && IsScopeInvariantExpr(*bound)) {
- return *bound;
- } else if (IsDescriptor(symbol)) {
+ Result operator()(const Symbol &symbol0) const {
+ const Symbol &symbol{symbol0.GetUltimate()};
+ if (const auto *details{
+ symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
+ int rank{details->shape().Rank()};
+ if (dimension_ < rank) {
+ const semantics::ShapeSpec &shapeSpec{details->shape()[dimension_]};
+ if (shapeSpec.lbound().isExplicit()) {
+ if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
+ if constexpr (LBOUND_SEMANTICS) {
+ bool ok{false};
+ auto lbValue{ToInt64(*lbound)};
+ if (dimension_ == rank - 1 && details->IsAssumedSize()) {
+ // last dimension of assumed-size dummy array: don't worry
+ // about handling an empty dimension
+ ok = IsScopeInvariantExpr(*lbound);
+ } else if (lbValue.value_or(0) == 1) {
+ // Lower bound is 1, regardless of extent
+ ok = true;
+ } else if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
+ // If we can't prove that the dimension is nonempty,
+ // we must be conservative.
+ // TODO: simple symbolic math in expression rewriting to
+ // cope with cases like A(J:J)
+ if (context_) {
+ auto extent{ToInt64(Fold(*context_,
+ ExtentExpr{*ubound} - ExtentExpr{*lbound} +
+ ExtentExpr{1}))};
+ ok = extent && *extent > 0;
+ } else {
+ auto ubValue{ToInt64(*ubound)};
+ ok = lbValue && ubValue && *lbValue <= *ubValue;
+ }
+ }
+ return ok ? *lbound : Result{};
+ } else {
+ return *lbound;
+ }
+ } else {
+ return Result{1};
+ }
+ }
+ if (IsDescriptor(symbol)) {
return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
DescriptorInquiry::Field::LowerBound, dimension_}};
- } else {
- break;
}
}
- }
- } else if (const auto *assoc{
- symbol.detailsIf<semantics::AssocEntityDetails>()}) {
- if (assoc->rank()) { // SELECT RANK case
- const Symbol &resolved{ResolveAssociations(symbol)};
- if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
- return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
- DescriptorInquiry::Field::LowerBound, dimension_}};
+ } else if (const auto *assoc{
+ symbol.detailsIf<semantics::AssocEntityDetails>()}) {
+ if (assoc->rank()) { // SELECT RANK case
+ const Symbol &resolved{ResolveAssociations(symbol)};
+ if (IsDescriptor(resolved) && dimension_ < *assoc->rank()) {
+ return ExtentExpr{DescriptorInquiry{NamedEntity{symbol0},
+ DescriptorInquiry::Field::LowerBound, dimension_}};
+ }
+ } else {
+ return (*this)(assoc->expr());
}
+ }
+ if constexpr (LBOUND_SEMANTICS) {
+ return Result{};
} else {
- return (*this)(assoc->expr());
+ return Result{1};
}
}
- return Default();
-}
-auto GetLowerBoundHelper::operator()(const Component &component) -> Result {
- if (component.base().Rank() == 0) {
- const Symbol &symbol{component.GetLastSymbol().GetUltimate()};
- if (const auto *details{
- symbol.detailsIf<semantics::ObjectEntityDetails>()}) {
- int j{0};
- for (const auto &shapeSpec : details->shape()) {
- if (j++ == dimension_) {
- const auto &bound{shapeSpec.lbound().GetExplicit()};
- if (bound && IsScopeInvariantExpr(*bound)) {
- return *bound;
- } else if (IsDescriptor(symbol)) {
- return ExtentExpr{
- DescriptorInquiry{NamedEntity{common::Clone(component)},
- DescriptorInquiry::Field::LowerBound, dimension_}};
- } else {
- break;
- }
- }
- }
+ Result operator()(const Component &component) const {
+ if (component.base().Rank() == 0) {
+ return (*this)(component.GetLastSymbol());
}
+ return Result{1};
}
- return Default();
+
+private:
+ int dimension_;
+ FoldingContext *context_{nullptr};
+};
+
+ExtentExpr GetRawLowerBound(const NamedEntity &base, int dimension) {
+ return GetLowerBoundHelper<ExtentExpr, false>{dimension, nullptr}(base);
+}
+
+ExtentExpr GetRawLowerBound(
+ FoldingContext &context, const NamedEntity &base, int dimension) {
+ return Fold(context,
+ GetLowerBoundHelper<ExtentExpr, false>{dimension, &context}(base));
}
-ExtentExpr GetLowerBound(const NamedEntity &base, int dimension) {
- return GetLowerBoundHelper{dimension}(base);
+MaybeExtentExpr GetLBOUND(const NamedEntity &base, int dimension) {
+ return GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, nullptr}(base);
}
-ExtentExpr GetLowerBound(
+MaybeExtentExpr GetLBOUND(
FoldingContext &context, const NamedEntity &base, int dimension) {
- return Fold(context, GetLowerBound(base, dimension));
+ return Fold(context,
+ GetLowerBoundHelper<MaybeExtentExpr, true>{dimension, &context}(base));
}
-Shape GetLowerBounds(const NamedEntity &base) {
+Shape GetRawLowerBounds(const NamedEntity &base) {
Shape result;
int rank{base.Rank()};
for (int dim{0}; dim < rank; ++dim) {
- result.emplace_back(GetLowerBound(base, dim));
+ result.emplace_back(GetRawLowerBound(base, dim));
}
return result;
}
-Shape GetLowerBounds(FoldingContext &context, const NamedEntity &base) {
+Shape GetRawLowerBounds(FoldingContext &context, const NamedEntity &base) {
Shape result;
int rank{base.Rank()};
for (int dim{0}; dim < rank; ++dim) {
- result.emplace_back(GetLowerBound(context, base, dim));
+ result.emplace_back(GetRawLowerBound(context, base, dim));
+ }
+ return result;
+}
+
+Shape GetLBOUNDs(const NamedEntity &base) {
+ Shape result;
+ int rank{base.Rank()};
+ for (int dim{0}; dim < rank; ++dim) {
+ result.emplace_back(GetLBOUND(base, dim));
+ }
+ return result;
+}
+
+Shape GetLBOUNDs(FoldingContext &context, const NamedEntity &base) {
+ Shape result;
+ int rank{base.Rank()};
+ for (int dim{0}; dim < rank; ++dim) {
+ result.emplace_back(GetLBOUND(context, base, dim));
}
return result;
}
@@ -420,7 +470,7 @@ MaybeExtentExpr GetExtent(
}
MaybeExtentExpr lower{triplet.lower()};
if (!lower) {
- lower = GetLowerBound(base, dimension);
+ lower = GetLBOUND(base, dimension);
}
return CountTrips(std::move(lower), std::move(upper),
MaybeExtentExpr{triplet.stride()});
@@ -472,9 +522,8 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
return *bound;
} else if (details->IsAssumedSize() && dimension + 1 == symbol.Rank()) {
break;
- } else {
- return ComputeUpperBound(
- GetLowerBound(base, dimension), GetExtent(base, dimension));
+ } else if (auto lb{GetLBOUND(base, dimension)}) {
+ return ComputeUpperBound(std::move(*lb), GetExtent(base, dimension));
}
}
}
@@ -482,8 +531,10 @@ MaybeExtentExpr GetUpperBound(const NamedEntity &base, int dimension) {
symbol.detailsIf<semantics::AssocEntityDetails>()}) {
if (auto shape{GetShape(assoc->expr())}) {
if (dimension < static_cast<int>(shape->size())) {
- return ComputeUpperBound(
- GetLowerBound(base, dimension), std::move(shape->at(dimension)));
+ if (auto lb{GetLBOUND(base, dimension)}) {
+ return ComputeUpperBound(
+ std::move(*lb), std::move(shape->at(dimension)));
+ }
}
}
}
@@ -506,9 +557,11 @@ Shape GetUpperBounds(const NamedEntity &base) {
result.push_back(*bound);
} else if (details->IsAssumedSize() && dim + 1 == base.Rank()) {
result.emplace_back(std::nullopt); // UBOUND folding replaces with -1
- } else {
+ } else if (auto lb{GetLBOUND(base, dim)}) {
result.emplace_back(
- ComputeUpperBound(GetLowerBound(base, dim), GetExtent(base, dim)));
+ ComputeUpperBound(std::move(*lb), GetExtent(base, dim)));
+ } else {
+ result.emplace_back(); // unknown
}
++dim;
}
diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp
index feda8da14c23e..477ac78468133 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -794,9 +794,10 @@ evaluate::StructureConstructor RuntimeTableBuilder::DescribeComponent(
std::vector<evaluate::StructureConstructor> bounds;
evaluate::NamedEntity entity{symbol};
for (int j{0}; j < rank; ++j) {
- bounds.emplace_back(GetValue(std::make_optional(evaluate::GetLowerBound(
- foldingContext, entity, j)),
- parameters));
+ bounds.emplace_back(
+ GetValue(std::make_optional(
+ evaluate::GetRawLowerBound(foldingContext, entity, j)),
+ parameters));
bounds.emplace_back(GetValue(
evaluate::GetUpperBound(foldingContext, entity, j), parameters));
}
diff --git a/flang/runtime/ISO_Fortran_binding.cpp b/flang/runtime/ISO_Fortran_binding.cpp
index 1e5da86d8b4c9..e4d8cc286cad7 100644
--- a/flang/runtime/ISO_Fortran_binding.cpp
+++ b/flang/runtime/ISO_Fortran_binding.cpp
@@ -72,7 +72,7 @@ int CFI_allocate(CFI_cdesc_t *descriptor, const CFI_index_t lower_bounds[],
CFI_index_t lb{lower_bounds[j]};
CFI_index_t ub{upper_bounds[j]};
CFI_index_t extent{ub >= lb ? ub - lb + 1 : 0};
- dim->lower_bound = lb;
+ dim->lower_bound = extent == 0 ? 1 : lb;
dim->extent = extent;
dim->sm = byteSize;
byteSize *= extent;
@@ -361,8 +361,10 @@ int CFI_section(CFI_cdesc_t *result, const CFI_cdesc_t *source,
resRank = 0;
for (int j{0}; j < source->rank; ++j) {
if (actualStride[j] != 0) {
- result->dim[resRank].lower_bound = 0;
result->dim[resRank].extent = extent[j];
+ result->dim[resRank].lower_bound = extent[j] == 0 ? 1
+ : lower_bounds ? lower_bounds[j]
+ : source->dim[j].lower_bound;
result->dim[resRank].sm = actualStride[j] * source->dim[j].sm;
++resRank;
}
@@ -437,10 +439,12 @@ int CFI_setpointer(CFI_cdesc_t *result, const CFI_cdesc_t *source,
result->base_addr = source->base_addr;
if (source->base_addr) {
for (int j{0}; j < result->rank; ++j) {
- result->dim[j].extent = source->dim[j].extent;
+ CFI_index_t extent{source->dim[j].extent};
+ result->dim[j].extent = extent;
result->dim[j].sm = source->dim[j].sm;
- result->dim[j].lower_bound =
- copySrcLB ? source->dim[j].lower_bound : lower_bounds[j];
+ result->dim[j].lower_bound = extent == 0 ? 1
+ : copySrcLB ? source->dim[j].lower_bound
+ : lower_bounds[j];
}
}
return CFI_SUCCESS;
diff --git a/flang/runtime/pointer.cpp b/flang/runtime/pointer.cpp
index 8aebf1a603048..b396a04e1be84 100644
--- a/flang/runtime/pointer.cpp
+++ b/flang/runtime/pointer.cpp
@@ -76,9 +76,11 @@ void RTNAME(PointerAssociateLowerBounds)(Descriptor &pointer,
Terminator terminator{__FILE__, __LINE__};
std::size_t boundElementBytes{lowerBounds.ElementBytes()};
for (int j{0}; j < rank; ++j) {
- pointer.GetDimension(j).SetLowerBound(
- GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
- boundElementBytes, terminator));
+ Dimension &dim{pointer.GetDimension(j)};
+ dim.SetLowerBound(dim.Extent() == 0
+ ? 1
+ : GetInt64(lowerBounds.ZeroBasedIndexedElement<const char>(j),
+ boundElementBytes, terminator));
}
}
diff --git a/flang/test/Evaluate/folding08.f90 b/flang/test/Evaluate/folding08.f90
index c64a9590f3533..f00ec873a0324 100644
--- a/flang/test/Evaluate/folding08.f90
+++ b/flang/test/Evaluate/folding08.f90
@@ -2,50 +2,53 @@
! Test folding of LBOUND and UBOUND
module m
+ real :: a3(42:52)
+ integer, parameter :: lba3(*) = lbound(a3)
+ logical, parameter :: test_lba3 = all(lba3 == [42])
+ type :: t
+ real :: a
+ end type
+ type(t) :: ta(0:2)
+ character(len=2) :: ca(-1:1)
+ integer, parameter :: lbtadim = lbound(ta,1)
+ logical, parameter :: test_lbtadim = lbtadim == 0
+ integer, parameter :: ubtadim = ubound(ta,1)
+ logical, parameter :: test_ubtadim = ubtadim == 2
+ integer, parameter :: lbta1(*) = lbound(ta)
+ logical, parameter :: test_lbta1 = all(lbta1 == [0])
+ integer, parameter :: ubta1(*) = ubound(ta)
+ logical, parameter :: test_ubta1 = all(ubta1 == [2])
+ integer, parameter :: lbta2(*) = lbound(ta(:))
+ logical, parameter :: test_lbta2 = all(lbta2 == [1])
+ integer, parameter :: ubta2(*) = ubound(ta(:))
+ logical, parameter :: test_ubta2 = all(ubta2 == [3])
+ integer, parameter :: lbta3(*) = lbound(ta%a)
+ logical, parameter :: test_lbta3 = all(lbta3 == [1])
+ integer, parameter :: ubta3(*) = ubound(ta%a)
+ logical, parameter :: test_ubta3 = all(ubta3 == [3])
+ integer, parameter :: lbca1(*) = lbound(ca)
+ logical, parameter :: test_lbca1 = all(lbca1 == [-1])
+ integer, parameter :: ubca1(*) = ubound(ca)
+ logical, parameter :: test_ubca1 = all(ubca1 == [1])
+ integer, parameter :: lbca2(*) = lbound(ca(:)(1:1))
+ logical, parameter :: test_lbca2 = all(lbca2 == [1])
+ integer, parameter :: ubca2(*) = ubound(ca(:)(1:1))
+ logical, parameter :: test_ubca2 = all(ubca2 == [3])
+ integer, parameter :: lbfoo(*) = lbound(foo())
+ logical, parameter :: test_lbfoo = all(lbfoo == [1,1])
+ integer, parameter :: ubfoo(*) = ubound(foo())
+ logical, parameter :: test_ubfoo = all(ubfoo == [2,3])
contains
function foo()
real :: foo(2:3,4:6)
end function
subroutine test(n1,a1,a2)
integer, intent(in) :: n1
- real, intent(in) :: a1(0:n1), a2(0:*)
- type :: t
- real :: a
- end type
- type(t) :: ta(0:2)
- character(len=2) :: ca(-1:1)
+ real, intent(in) :: a1(1:n1), a2(0:*)
integer, parameter :: lba1(*) = lbound(a1)
- logical, parameter :: test_lba1 = all(lba1 == [0])
+ logical, parameter :: test_lba1 = all(lba1 == [1])
integer, parameter :: lba2(*) = lbound(a2)
logical, parameter :: test_lba2 = all(lba2 == [0])
- integer, parameter :: lbtadim = lbound(ta,1)
- logical, parameter :: test_lbtadim = lbtadim == 0
- integer, parameter :: ubtadim = ubound(ta,1)
- logical, parameter :: test_ubtadim = ubtadim == 2
- integer, parameter :: lbta1(*) = lbound(ta)
- logical, parameter :: test_lbta1 = all(lbta1 == [0])
- integer, parameter :: ubta1(*) = ubound(ta)
- logical, parameter :: test_ubta1 = all(ubta1 == [2])
- integer, parameter :: lbta2(*) = lbound(ta(:))
- logical, parameter :: test_lbta2 = all(lbta2 == [1])
- integer, parameter :: ubta2(*) = ubound(ta(:))
- logical, parameter :: test_ubta2 = all(ubta2 == [3])
- integer, parameter :: lbta3(*) = lbound(ta%a)
- logical, parameter :: test_lbta3 = all(lbta3 == [1])
- integer, parameter :: ubta3(*) = ubound(ta%a)
- logical, parameter :: test_ubta3 = all(ubta3 == [3])
- integer, parameter :: lbca1(*) = lbound(ca)
- logical, parameter :: test_lbca1 = all(lbca1 == [-1])
- integer, parameter :: ubca1(*) = ubound(ca)
- logical, parameter :: test_ubca1 = all(ubca1 == [1])
- integer, parameter :: lbca2(*) = lbound(ca(:)(1:1))
- logical, parameter :: test_lbca2 = all(lbca2 == [1])
- integer, parameter :: ubca2(*) = ubound(ca(:)(1:1))
- logical, parameter :: test_ubca2 = all(ubca2 == [3])
- integer, parameter :: lbfoo(*) = lbound(foo())
- logical, parameter :: test_lbfoo = all(lbfoo == [1,1])
- integer, parameter :: ubfoo(*) = ubound(foo())
- logical, parameter :: test_ubfoo = all(ubfoo == [2,3])
end subroutine
subroutine test2
real :: a(2:3,4:6)
More information about the flang-commits
mailing list