diff options
author | Peter Klausler <pklausler@nvidia.com> | 2022-03-10 00:43:54 +0300 |
---|---|---|
committer | Peter Klausler <pklausler@nvidia.com> | 2022-03-14 21:16:09 +0300 |
commit | 3b61587c9e27747438a0364f8b8cf19273142452 (patch) | |
tree | 769c2bfa3f29df57933c5d533fb8eb27105da0b4 /flang | |
parent | c2e7e7595439be81b498de842ee49e4409645c0e (diff) |
[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
Diffstat (limited to 'flang')
-rw-r--r-- | flang/docs/Extensions.md | 4 | ||||
-rw-r--r-- | flang/include/flang/Evaluate/shape.h | 19 | ||||
-rw-r--r-- | flang/include/flang/Runtime/descriptor.h | 11 | ||||
-rw-r--r-- | flang/lib/Evaluate/check-expression.cpp | 8 | ||||
-rw-r--r-- | flang/lib/Evaluate/constant.cpp | 5 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-designator.cpp | 4 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold-integer.cpp | 7 | ||||
-rw-r--r-- | flang/lib/Evaluate/fold.cpp | 9 | ||||
-rw-r--r-- | flang/lib/Evaluate/shape.cpp | 197 | ||||
-rw-r--r-- | flang/lib/Semantics/runtime-type-info.cpp | 7 | ||||
-rw-r--r-- | flang/runtime/ISO_Fortran_binding.cpp | 14 | ||||
-rw-r--r-- | flang/runtime/pointer.cpp | 8 | ||||
-rw-r--r-- | flang/test/Evaluate/folding08.f90 | 73 |
13 files changed, 229 insertions, 137 deletions
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md index 4a038742ddb3..8b84045d2011 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 29b1bafff29b..2bf286f000ff 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 9666f9c0422a..376d3bb95e65 100644 --- a/flang/include/flang/Runtime/descriptor.h +++ b/flang/include/flang/Runtime/descriptor.h @@ -50,10 +50,17 @@ public: 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 e4423f8c300f..c780b51d7270 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 9f2040ce8575..19c3c2aa913a 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 45ae691d4b84..f3e1cf40cb8a 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 53dfaf240c33..8dcb7c093469 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 c6397e46c48e..f3c2e6ca1c56 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 bb5e6ea4cd37..e8caf47abfd8 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 feda8da14c23..477ac7846813 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 1e5da86d8b4c..e4d8cc286cad 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 8aebf1a60304..b396a04e1be8 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 c64a9590f353..f00ec873a032 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) |