[flang-commits] [flang] [flang][Lower] Implement lowering for new expression kind used in explicit-shape-bounds-spec (PR #215403)
via flang-commits
flang-commits at lists.llvm.org
Sat Sep 19 11:00:19 PDT 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/215403
>From b05b5f121ae1d2fcd80504ac7330eb5d7d4bf7d4 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 10 Aug 2026 16:53:59 -0500
Subject: [PATCH 1/6] [flang][Lower] Implement lowering for new expression kind
As part of rank-1 integer array handling in explicit shape bounds, a new class was introduced to scalarize rank-1 integer array bounds. This commit implements the lowering for such an expression.
Also, change semantic analysis to fold before Lower when possible. This was initially intentional so that we would still get the symbol when exporting to a modfile, but after seeing existing behavior for the equivalent test case using the old syntax for explicit-shape bounds, which is to lose the symbol and fold to a constant, fold when possible and lose the RankOneBoundElement object. Otherwise, we would need to special case ROBEs to fold during Lower.
---
flang/lib/Evaluate/check-expression.cpp | 2 +-
flang/lib/Lower/ConvertExprToHLFIR.cpp | 18 ++-
flang/lib/Semantics/resolve-names-utils.cpp | 14 ++-
.../Lower/HLFIR/explicit-shape-bounds.f90 | 104 ++++++++++++++++++
.../modfile-explicit-shape-bounds.f90 | 2 +-
5 files changed, 132 insertions(+), 8 deletions(-)
create mode 100644 flang/test/Lower/HLFIR/explicit-shape-bounds.f90
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 737502a504d61..76fa6df441d1c 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -1808,7 +1808,7 @@ class CollectUsedSymbolValuesHelper
return {}; // doesn't count as a use
}
Result operator()(const RankOneBoundElement &x) const {
- return {}; // unreachable
+ return (*this)(x.base());
}
template <typename T> Result operator()(const ConditionalExpr<T> &condExpr) {
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index 59ef7143914b2..679fc9820eb94 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1865,7 +1865,23 @@ class HlfirBuilder {
hlfir::EntityWithAttributes
gen(const Fortran::evaluate::RankOneBoundElement &x) {
- TODO(getLoc(), "rank-1 bound element lowering");
+ mlir::Location loc = getLoc();
+ auto &builder = getBuilder();
+ using ResTy = Fortran::evaluate::RankOneBoundElement::Result;
+ mlir::Type resultType =
+ getConverter().genType(ResTy::category, ResTy::kind);
+ // Evaluate the rank-1 base expression.
+ Fortran::lower::SomeExpr someExpr{Fortran::evaluate::AsGenericExpr(
+ Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger>{
+ Fortran::common::Clone(x.base())})};
+ hlfir::Entity baseArray{Fortran::lower::convertExprToHLFIR(
+ loc, getConverter(), someExpr, getSymMap(), getStmtCtx())};
+ // Extract element at dimension (1-based index).
+ mlir::Value idx = builder.createIntegerConstant(loc, builder.getIndexType(),
+ x.dimension() + 1);
+ mlir::Value elem = hlfir::loadElementAt(loc, builder, baseArray, {idx});
+ return hlfir::EntityWithAttributes{
+ builder.createConvert(loc, resultType, elem)};
}
/// Generate a conditional expression as an hlfir.conditional op whose
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 6580c7e31abdb..5fa912cdf321e 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -560,7 +560,9 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
}
// For rank-1 bounds, emit N ShapeSpecs each wrapping a scalar
// RankOneBoundElement that extracts element [dim] from the rank-1
- // expression. This makes all downstream consumers see scalar bounds.
+ // expression, then fold: a constant rank-1 base collapses to a scalar
+ // constant (as if written dims(1),dims(2),...), while a non-constant base
+ // keeps the RankOneBoundElement for lowering and mod-file round-tripping.
int numDims = static_cast<int>(result->numDims);
if (numDims == 0) {
// A zero-size bounds array declares a scalar (rank 0); leave arraySpec_
@@ -580,8 +582,9 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
MaybeSubscriptIntExpr ubExpr;
if (auto &ubOrig = result->ubound.GetExplicit()) {
if (ubOrig->Rank() > 0) {
- ubExpr = SubscriptIntExpr{
- evaluate::RankOneBoundElement{common::Clone(*ubOrig), dim}};
+ ubExpr = evaluate::Fold(context_.foldingContext(),
+ SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*ubOrig), dim}});
} else {
ubExpr = common::Clone(*ubOrig);
}
@@ -591,8 +594,9 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
if (result->lbound) {
if (auto &lbOrig = result->lbound->GetExplicit()) {
if (lbOrig->Rank() > 0) {
- lbExpr = SubscriptIntExpr{
- evaluate::RankOneBoundElement{common::Clone(*lbOrig), dim}};
+ lbExpr = evaluate::Fold(context_.foldingContext(),
+ SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*lbOrig), dim}});
} else {
lbExpr = common::Clone(*lbOrig);
}
diff --git a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90 b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
new file mode 100644
index 0000000000000..c022ec4214668
--- /dev/null
+++ b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
@@ -0,0 +1,104 @@
+! Test lowering of explicit-shape bounds using rank-1 integer arrays
+! (RankOneBoundElement in the evaluate representation).
+! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
+
+! Test with PARAMETER rank-1 bounds: the constant array is folded so the
+! explicit-shape bounds become compile-time constants (no runtime load).
+module test_param
+contains
+ subroutine test_param_bounds()
+ integer, parameter :: dims(3) = [2, 3, 4]
+ real :: a(dims)
+ a(1,1,1) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_paramPtest_param_bounds()
+! CHECK: %[[C2:.*]] = arith.constant 2 : index
+! CHECK: %[[C3:.*]] = arith.constant 3 : index
+! CHECK: %[[C4:.*]] = arith.constant 4 : index
+! CHECK: fir.alloca !fir.array<2x3x4xf32>
+! CHECK: fir.shape %[[C2]], %[[C3]], %[[C4]] : (index, index, index) -> !fir.shape<3>
+
+! Test with rank-1 dummy as upper bounds only.
+module test_dummy_upper
+contains
+ subroutine test_dummy_upper_bounds(n)
+ integer, intent(in) :: n(3)
+ real :: a(n)
+ a(1,1,1) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_dummy_upperPtest_dummy_upper_bounds(
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<3xi64>
+! CHECK: ^bb0(%arg{{.*}}: index):
+! CHECK: hlfir.designate {{.*}} (%arg{{.*}}) : ({{.*}}, index) -> !fir.ref<i32>
+! CHECK: fir.load {{.*}} : !fir.ref<i32>
+! CHECK: fir.convert {{.*}} : (i32) -> i64
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply {{.*}}, %[[C1]] : (!hlfir.expr<3xi64>, index) -> i64
+! CHECK: %[[C2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply {{.*}}, %[[C2]] : (!hlfir.expr<3xi64>, index) -> i64
+! CHECK: %[[C3:.*]] = arith.constant 3 : index
+! CHECK: hlfir.apply {{.*}}, %[[C3]] : (!hlfir.expr<3xi64>, index) -> i64
+
+! Test with both lower and upper rank-1 bounds.
+module test_dummy_both
+contains
+ subroutine test_dummy_both_bounds(lb, ub)
+ integer, intent(in) :: lb(2), ub(2)
+ real :: a(lb:ub)
+ a(1,1) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_dummy_bothPtest_dummy_both_bounds(
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[C1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply {{.*}}, %[[C1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[C1_1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply {{.*}}, %[[C1_1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[C2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply {{.*}}, %[[C2]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[C2_1:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply {{.*}}, %[[C2_1]] : (!hlfir.expr<2xi64>, index) -> i64
+
+! Test broadcast of scalar lower bound with rank-1 upper bounds.
+module test_broadcast
+contains
+ subroutine test_broadcast_bounds(ub)
+ integer, intent(in) :: ub(2)
+ real :: a(0:ub)
+ a(0,0) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_broadcastPtest_broadcast_bounds(
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[U1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply {{.*}}, %[[U1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[U2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply {{.*}}, %[[U2]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: fir.shape_shift {{.*}} : (index, index, index, index) -> !fir.shapeshift<2>
+
+! Test rank-1 dummy bounds of explicit integer kinds: the bound base is always
+! coerced to a 64-bit subscript, so INTEGER(4) is widened (element loaded as i32
+! then converted to i64) while INTEGER(8) is already 64-bit and loaded directly.
+module test_bound_kinds
+contains
+ subroutine test_bound_kinds_bounds(n4, n8)
+ integer(4), intent(in) :: n4(2)
+ integer(8), intent(in) :: n8(2)
+ real :: a4(n4)
+ real :: a8(n8)
+ a4(1,1) = 1.0
+ a8(1,1) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_bound_kindsPtest_bound_kinds_bounds(
+! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: hlfir.designate {{.*}} (%arg{{.*}}) : ({{.*}}, index) -> !fir.ref<i32>
+! CHECK: fir.load {{.*}} : !fir.ref<i32>
+! CHECK: fir.convert {{.*}} : (i32) -> i64
+! CHECK: hlfir.designate {{.*}} : ({{.*}}, index) -> !fir.ref<i64>
+! CHECK: fir.load {{.*}} : !fir.ref<i64>
diff --git a/flang/test/Semantics/modfile-explicit-shape-bounds.f90 b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
index 11b596012c2c2..7f9ac97200076 100644
--- a/flang/test/Semantics/modfile-explicit-shape-bounds.f90
+++ b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
@@ -11,7 +11,7 @@ module m1
!Expect: m1.mod
!module m1
!integer(4),parameter::dims(1_8:3_8)=[INTEGER(4)::5_4,10_4,15_4]
-!real(4)::a(1_8:[INTEGER(8)::5_8,10_8,15_8])
+!real(4)::a(1_8:5_8,1_8:10_8,1_8:15_8)
!end
! Rank-1 dummy as upper bounds
>From 3bc7a4ffc0a51217ed16c815397a89b1215a3caa Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 15 Sep 2026 18:53:24 -0500
Subject: [PATCH 2/6] Don't fold ROBE before storing, handle all types for
Folding ROBE
Change ROBE implementation by NOT folding ROBE before storing in AST node. Previously, folding before storing was essentially just undoing the ROBE itself when foldable. This messed with accurate ROBE detection in the mod-file printer. After this change, there was no further changes or special casing needed in the mod-file printer.
Address can of worms opened up by Eugene's suggested test case. Essentially, we need to be particular about what to do when we request a LONE ROBE by itself: I previously assumed we would only ever use the entire bound, that is the entire rank-1 integer array. This is clearly false because of the existence of ubound/lbound intrinsics. Cover all imaginable cases that can produce a rank-1 integer array, and reduce when possible. For example, a genuinely non-reducible is user defined function references, since you can't index into the return value without an intermediary temporary. This takes care of itself by emitting a descriptor inquiry, since functions are never scope-invariant. But there are other cases where we still need to "leak" the builtin ROBE wrapper. So also add support for a __builtin_rank1BoundElement wrapper that is recognized and parseable by the compiler, reconstructing an internal ROBE node.
---
flang/include/flang/Evaluate/intrinsics.h | 8 +
flang/include/flang/Semantics/expression.h | 1 +
flang/lib/Evaluate/fold-integer.cpp | 225 +++++++++++-
flang/lib/Evaluate/formatting.cpp | 5 +-
flang/lib/Evaluate/intrinsics.cpp | 1 +
flang/lib/Semantics/expression.cpp | 35 ++
flang/lib/Semantics/resolve-names-utils.cpp | 18 +-
.../modfile-explicit-shape-bounds.f90 | 345 +++++++++++++++++-
.../Semantics/modfile-rank1-bound-element.f90 | 35 ++
.../Semantics/rank1-bound-element-symbols.f90 | 2 +-
10 files changed, 657 insertions(+), 18 deletions(-)
create mode 100644 flang/test/Semantics/modfile-rank1-bound-element.f90
diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index 3a165e7ce29a2..b5774b16df3a0 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -117,6 +117,14 @@ class IntrinsicProcTable {
// Name of intrinsics used in various locations.
static inline const char *const BuiltinIntName{"__builtin_int"};
+ // Name of the synthetic wrapper used to render a RankOneBoundElement (a
+ // single element extracted from a rank-1 array bound) in a form that
+ // round-trips through a mod file. It must be spelled in all lower case so
+ // that it still matches after names are folded to lower case when the mod
+ // file is read back in.
+ static inline const char *const BuiltinRank1BoundElementName{
+ "__builtin_rank1_bound_element"};
+
llvm::raw_ostream &Dump(llvm::raw_ostream &) const;
private:
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 59cd424c4dae9..c84a80b0682d8 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -397,6 +397,7 @@ class ExpressionAnalyzer {
MaybeExpr MakeFunctionRef(
parser::CharBlock, ProcedureDesignator &&, ActualArguments &&);
MaybeExpr MakeFunctionRef(parser::CharBlock intrinsic, ActualArguments &&);
+ MaybeExpr AnalyzeRankOneBoundElement(parser::CharBlock, ActualArguments &&);
template <typename T> T Fold(T &&expr) {
return evaluate::Fold(foldingContext_, std::move(expr));
}
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index c7db4069e3e28..04add1a1acce1 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1570,15 +1570,230 @@ Expr<TypeParamInquiry::Result> FoldOperation(
return AsExpr(std::move(inquiry));
}
+// Extract element [dim] (0-based, array-element order) from a rank-1 integer
+// array expression as a scalar, distributing the extraction through kind
+// conversions, elementwise integer operations, and elemental intrinsic calls,
+// and indexing array sections and array constructors (including implied-dos),
+// so the result is genuine Fortran that round-trips through module files.
+// Returns std::nullopt when a leaf cannot be reduced (e.g. a user function
+// reference), so the caller keeps the RankOneBoundElement unchanged.
+template <int KIND>
+static std::optional<Expr<Type<TypeCategory::Integer, KIND>>>
+ExtractRankOneElement(FoldingContext &context,
+ const Expr<Type<TypeCategory::Integer, KIND>> &base, int dim) {
+ using T = Type<TypeCategory::Integer, KIND>;
+ if (base.Rank() == 0) {
+ return base; // a scalar operand contributes itself to every element
+ }
+ return common::visit(
+ [&](const auto &y) -> std::optional<Expr<T>> {
+ using Ty = std::decay_t<decltype(y)>;
+ if constexpr (std::is_same_v<Ty, Constant<T>>) {
+ ConstantSubscripts at{y.lbounds()};
+ at[0] = y.lbounds()[0] + dim;
+ return Expr<T>{Constant<T>{y.At(at)}};
+ } else if constexpr (std::is_same_v<Ty, Designator<T>>) {
+ if (auto named{ExtractNamedEntity(Expr<T>{y})}) {
+ // Whole array or component: element [dim] is base(lbound+dim).
+ if (MaybeExtentExpr lb{GetLBOUND(context, *named, /*dim=*/0)}) {
+ Expr<SubscriptInteger> at{
+ Fold(context, std::move(*lb) + Expr<SubscriptInteger>{dim})};
+ std::vector<Subscript> ss;
+ ss.emplace_back(std::move(at));
+ ArrayRef ref{std::move(*named), std::move(ss)};
+ if (auto elem{AsGenericExpr(DataRef{std::move(ref)})}) {
+ if (auto *ie{UnwrapExpr<Expr<SomeInteger>>(*elem)}) {
+ return ConvertToType<T>(std::move(*ie));
+ }
+ }
+ }
+ } else if (const auto *aref{std::get_if<ArrayRef>(&y.u)}) {
+ // Array section base(l:u:s): element [dim] is base(l+dim*s).
+ std::vector<Subscript> ss;
+ bool built{false}, ok{true};
+ for (int j{0}; ok && j < aref->size(); ++j) {
+ const Subscript &sub{aref->at(j)};
+ if (const auto *trip{std::get_if<Triplet>(&sub.u)}) {
+ if (built) { // only one rank-1 triplet is expected
+ ok = false;
+ break;
+ }
+ std::optional<Expr<SubscriptInteger>> lower;
+ if (const auto *lo{trip->GetLower()}) {
+ lower = *lo;
+ } else if (auto lb{GetLBOUND(context, aref->base(), j)}) {
+ lower = std::move(*lb);
+ } else {
+ ok = false;
+ break;
+ }
+ ss.emplace_back(Fold(context,
+ std::move(*lower) +
+ Expr<SubscriptInteger>{dim} * trip->stride()));
+ built = true;
+ } else if (sub.Rank() == 0) {
+ ss.emplace_back(sub);
+ } else {
+ ok = false; // vector subscript: not handled here
+ }
+ }
+ if (ok && built) {
+ ArrayRef ref{NamedEntity{aref->base()}, std::move(ss)};
+ if (auto elem{AsGenericExpr(DataRef{std::move(ref)})}) {
+ if (auto *ie{UnwrapExpr<Expr<SomeInteger>>(*elem)}) {
+ return ConvertToType<T>(std::move(*ie));
+ }
+ }
+ }
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty, ArrayConstructor<T>>) {
+ // Pull element [dim] straight out of the constructor's values
+ // instead of wrapping the whole constructor.
+ ConstantSubscript target{dim};
+ for (const auto &value : y) {
+ if (const auto *e{std::get_if<Expr<T>>(&value.u)}) {
+ if (e->Rank() != 0) {
+ return std::nullopt; // array-valued element: too complex
+ }
+ if (target == 0) {
+ return Expr<T>{*e};
+ }
+ --target;
+ } else {
+ const auto &ido{std::get<ImpliedDo<T>>(value.u)};
+ auto lower{
+ ToInt64(Fold(context, Expr<SubscriptInteger>{ido.lower()}))};
+ auto upper{
+ ToInt64(Fold(context, Expr<SubscriptInteger>{ido.upper()}))};
+ auto stride{
+ ToInt64(Fold(context, Expr<SubscriptInteger>{ido.stride()}))};
+ if (!lower || !upper || !stride || *stride == 0) {
+ return std::nullopt;
+ }
+ // A scalar-per-value body contributes one element per iteration.
+ ConstantSubscript perTrip{0};
+ for (const auto &bv : ido.values()) {
+ const auto *be{std::get_if<Expr<T>>(&bv.u)};
+ if (!be || be->Rank() != 0) {
+ return std::nullopt; // nested/array body: too complex
+ }
+ ++perTrip;
+ }
+ ConstantSubscript trips{(*upper - *lower + *stride) / *stride};
+ if (trips < 0) {
+ trips = 0;
+ }
+ if (ConstantSubscript total{trips * perTrip}; target < total) {
+ ConstantSubscript iVal{*lower + (target / perTrip) * *stride};
+ ConstantSubscript within{target % perTrip};
+ context.StartImpliedDo(ido.name(), iVal);
+ std::optional<Expr<T>> result;
+ ConstantSubscript k{0};
+ for (const auto &bv : ido.values()) {
+ if (k++ == within) {
+ result = Fold(context, Expr<T>{std::get<Expr<T>>(bv.u)});
+ break;
+ }
+ }
+ context.EndImpliedDo(ido.name());
+ return result;
+ } else {
+ target -= total;
+ }
+ }
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty, Parentheses<T>>) {
+ if (auto op{ExtractRankOneElement(context, y.left(), dim)}) {
+ return Expr<T>{Parentheses<T>{std::move(*op)}};
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty, Negate<T>>) {
+ if (auto op{ExtractRankOneElement(context, y.left(), dim)}) {
+ return Expr<T>{Negate<T>{std::move(*op)}};
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty, Add<T>> ||
+ std::is_same_v<Ty, Subtract<T>> ||
+ std::is_same_v<Ty, Multiply<T>> || std::is_same_v<Ty, Divide<T>>) {
+ auto l{ExtractRankOneElement(context, y.left(), dim)};
+ auto r{ExtractRankOneElement(context, y.right(), dim)};
+ if (l && r) {
+ return Expr<T>{Ty{std::move(*l), std::move(*r)}};
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty, Extremum<T>>) {
+ auto l{ExtractRankOneElement(context, y.left(), dim)};
+ auto r{ExtractRankOneElement(context, y.right(), dim)};
+ if (l && r) {
+ return Expr<T>{
+ Extremum<T>{y.ordering, std::move(*l), std::move(*r)}};
+ }
+ return std::nullopt;
+ } else if constexpr (std::is_same_v<Ty,
+ Convert<T, TypeCategory::Integer>>) {
+ return common::visit(
+ [&](const auto &inner) -> std::optional<Expr<T>> {
+ if (auto op{ExtractRankOneElement(context, inner, dim)}) {
+ return Expr<T>{Convert<T, TypeCategory::Integer>{
+ Expr<SomeInteger>{std::move(*op)}}};
+ }
+ return std::nullopt;
+ },
+ y.left().u);
+ } else if constexpr (std::is_same_v<Ty, FunctionRef<T>>) {
+ // Elemental intrinsic f(array): element [dim] is f(array(dim)).
+ if (y.proc().GetSpecificIntrinsic() && y.IsElemental()) {
+ FunctionRef<T> reduced{y};
+ bool ok{true};
+ for (auto &arg : reduced.arguments()) {
+ if (!arg) {
+ continue; // absent optional argument
+ }
+ Expr<SomeType> *e{arg->UnwrapExpr()};
+ if (!e) {
+ ok = false;
+ break;
+ }
+ if (e->Rank() == 0) {
+ continue; // scalar argument contributes itself
+ }
+ auto *ie{std::get_if<Expr<SomeInteger>>(&e->u)};
+ if (!ie ||
+ !common::visit(
+ [&](auto &kx) {
+ if (auto elem{
+ ExtractRankOneElement(context, kx, dim)}) {
+ kx = std::move(*elem);
+ return true;
+ }
+ return false;
+ },
+ ie->u)) {
+ ok = false; // non-integer or irreducible array argument
+ break;
+ }
+ }
+ if (ok) {
+ return Expr<T>{std::move(reduced)};
+ }
+ }
+ return std::nullopt;
+ } else {
+ return std::nullopt; // user function, transformational intrinsic,
+ // etc.
+ }
+ },
+ base.u);
+}
+
Expr<RankOneBoundElement::Result> FoldOperation(
FoldingContext &context, RankOneBoundElement &&x) {
using ResultType = RankOneBoundElement::Result;
auto folded{Fold(context, Expr<ResultType>{x.base()})};
- if (auto *c{UnwrapConstantValue<ResultType>(folded)}) {
- // Base is a constant array; extract the element at dimension_ (0-based).
- ConstantSubscripts at{c->lbounds()};
- at[0] = c->lbounds()[0] + x.dimension();
- return Expr<ResultType>{Constant<ResultType>{c->At(at)}};
+ if (auto reduced{ExtractRankOneElement(context, folded, x.dimension())}) {
+ return Fold(context, std::move(*reduced));
}
return Expr<ResultType>{
RankOneBoundElement{std::move(folded), x.dimension()}};
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index fcedd15ee1791..4e46102d01d3e 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -897,8 +897,9 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const {
llvm::raw_ostream &RankOneBoundElement::AsFortran(llvm::raw_ostream &o) const {
// A RankOneBoundElement extracts a single element from a rank-1 array that
// was used as an array bound in a declaration; it has no true Fortran
- // surface syntax. Render it in an internal, clearly-synthetic form.
- base().AsFortran(o << "rank1BoundElement(")
+ // surface syntax. Render it as a recognized builtin so a mod file can
+ // round-trip it (see IntrinsicProcTable::BuiltinRank1BoundElementName).
+ base().AsFortran(o << IntrinsicProcTable::BuiltinRank1BoundElementName << "(")
<< ",dim=" << (dimension_ + 1) << ')';
return o;
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 748c6e0d14402..4caa6339ecd57 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2974,6 +2974,7 @@ bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
}
// special cases
return name == "__builtin_c_loc" || name == "__builtin_c_devloc" ||
+ name == IntrinsicProcTable::BuiltinRank1BoundElementName ||
name == "null";
}
bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine(
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index fc57cc43e981c..44a8f64f70bfd 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3699,6 +3699,18 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
if (analyzer.fatalErrors()) {
return std::nullopt;
}
+ // A mod file renders a RankOneBoundElement (a single element extracted from a
+ // rank-1 array bound) as a call to the synthetic builtin
+ // __builtin_rank1_bound_element(base, dim=N). It has no true Fortran surface
+ // syntax and no backing intrinsic, so rebuild the node here when the mod file
+ // is read back in.
+ if (const auto *name{std::get_if<parser::Name>(
+ &std::get<parser::ProcedureDesignator>(call.t).u)};
+ name &&
+ name->source.ToString() ==
+ IntrinsicProcTable::BuiltinRank1BoundElementName) {
+ return AnalyzeRankOneBoundElement(funcRef.source, analyzer.GetActuals());
+ }
bool mightBeStructureConstructor{structureConstructor != nullptr};
if (std::optional<CalleeAndArguments> callee{GetCalleeAndArguments(
std::get<parser::ProcedureDesignator>(call.t), analyzer.GetActuals(),
@@ -4891,6 +4903,29 @@ MaybeExpr ExpressionAnalyzer::MakeFunctionRef(
}
}
+// Rebuild a RankOneBoundElement from a mod file's
+// __builtin_rank1_bound_element(base, dim=N) call. N is one-based in the
+// rendered form; the node stores a zero-based dimension.
+MaybeExpr ExpressionAnalyzer::AnalyzeRankOneBoundElement(
+ parser::CharBlock source, ActualArguments &&arguments) {
+ if (arguments.size() == 2 && arguments[0] && arguments[1]) {
+ if (Expr<SomeType> * base{arguments[0]->UnwrapExpr()}) {
+ if (Expr<SomeType> * dim{arguments[1]->UnwrapExpr()}) {
+ if (auto *intBase{UnwrapExpr<Expr<SomeInteger>>(*base)}) {
+ if (std::optional<std::int64_t> dimValue{ToInt64(*dim)}) {
+ return AsGenericExpr(Expr<SubscriptInteger>{RankOneBoundElement{
+ ConvertToType<SubscriptInteger>(std::move(*intBase)),
+ static_cast<int>(*dimValue - 1)}});
+ }
+ }
+ }
+ }
+ }
+ Say(source, "Invalid use of compiler builtin '%s'"_err_en_US,
+ IntrinsicProcTable::BuiltinRank1BoundElementName);
+ return std::nullopt;
+}
+
MaybeExpr ExpressionAnalyzer::AnalyzeComplex(
MaybeExpr &&re, MaybeExpr &&im, const char *what) {
if (re && re->Rank() > 0) {
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 5fa912cdf321e..03cc5a41ef2b2 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -560,9 +560,11 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
}
// For rank-1 bounds, emit N ShapeSpecs each wrapping a scalar
// RankOneBoundElement that extracts element [dim] from the rank-1
- // expression, then fold: a constant rank-1 base collapses to a scalar
- // constant (as if written dims(1),dims(2),...), while a non-constant base
- // keeps the RankOneBoundElement for lowering and mod-file round-tripping.
+ // expression. The wrapper is intentionally left unfolded: consumers that
+ // need a concrete per-dimension value fold their own copy (a constant base
+ // then collapses to a scalar, as if written dims(1),dims(2),...), while the
+ // stored, unfolded wrapper lets the mod-file writer round-trip the original
+ // whole-array bound.
int numDims = static_cast<int>(result->numDims);
if (numDims == 0) {
// A zero-size bounds array declares a scalar (rank 0); leave arraySpec_
@@ -582,9 +584,8 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
MaybeSubscriptIntExpr ubExpr;
if (auto &ubOrig = result->ubound.GetExplicit()) {
if (ubOrig->Rank() > 0) {
- ubExpr = evaluate::Fold(context_.foldingContext(),
- SubscriptIntExpr{
- evaluate::RankOneBoundElement{common::Clone(*ubOrig), dim}});
+ ubExpr = SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*ubOrig), dim}};
} else {
ubExpr = common::Clone(*ubOrig);
}
@@ -594,9 +595,8 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
if (result->lbound) {
if (auto &lbOrig = result->lbound->GetExplicit()) {
if (lbOrig->Rank() > 0) {
- lbExpr = evaluate::Fold(context_.foldingContext(),
- SubscriptIntExpr{
- evaluate::RankOneBoundElement{common::Clone(*lbOrig), dim}});
+ lbExpr = SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*lbOrig), dim}};
} else {
lbExpr = common::Clone(*lbOrig);
}
diff --git a/flang/test/Semantics/modfile-explicit-shape-bounds.f90 b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
index 7f9ac97200076..16b8ea668998b 100644
--- a/flang/test/Semantics/modfile-explicit-shape-bounds.f90
+++ b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
@@ -11,7 +11,7 @@ module m1
!Expect: m1.mod
!module m1
!integer(4),parameter::dims(1_8:3_8)=[INTEGER(4)::5_4,10_4,15_4]
-!real(4)::a(1_8:5_8,1_8:10_8,1_8:15_8)
+!real(4)::a(1_8:[INTEGER(8)::5_8,10_8,15_8])
!end
! Rank-1 dummy as upper bounds
@@ -61,3 +61,346 @@ module m4
!module m4
!integer(4)::z
!end
+
+module m06
+ integer, parameter :: lbs_fold(2) = [0, 3]
+ integer :: lbs(2) = [0, 3]
+ integer, parameter :: ubs_fold(2) = [5, 7]
+contains
+ subroutine s(n, a_lbfold, a, a_bothfold)
+ integer, intent(in) :: n(2)
+ real, intent(inout) :: a_lbfold(lbs_fold : n) ! mixed const lbs_fold and dummy n
+ real, intent(inout) :: a(lbs : n)
+ real, intent(inout) :: a_bothfold(lbs_fold : ubs_fold) ! mixed const lbs_fold and dummy n
+ end subroutine
+end module
+
+!Expect: m06.mod
+!module m06
+!integer(4),parameter::lbs_fold(1_8:2_8)=[INTEGER(4)::0_4,3_4]
+!integer(4)::lbs(1_8:2_8)
+!integer(4),parameter::ubs_fold(1_8:2_8)=[INTEGER(4)::5_4,7_4]
+!contains
+!subroutines(n,a_lbfold,a,a_bothfold)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4),intent(inout)::a_lbfold([INTEGER(8)::0_8,3_8]:__builtin_int(n,kind=8))
+!real(4),intent(inout)::a(__builtin_int(lbs,kind=8):__builtin_int(n,kind=8))
+!real(4),intent(inout)::a_bothfold([INTEGER(8)::0_8,3_8]:[INTEGER(8)::5_8,7_8])
+!end
+!end
+
+module ccm1
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(2)
+ real :: a(n)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: ccm1.mod
+! module ccm1
+! contains
+! subroutine s(n,a,b)
+! integer(4),intent(in)::n(1_8:2_8)
+! real(4)::a(1_8:__builtin_int(n,kind=8))
+! real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8))
+! end
+! end
+
+!===============================================================================
+! SINGLE RankOneBoundElement (ROBE) reduction
+!
+! In every module below, `a` is given a rank-1 integer base of extent 2, so it
+! is a rank-2 F2023 explicit-shape array (one bounds-spec per element of the
+! base). `b(ubound(a,2))` then asks for ONE dimension's
+! extent: ubound(a,2) folds to a SINGLE ROBE that extracts element [2] of the
+! rank-1 base. That is exactly the case we care about here -- a lone ROBE that
+! must be rendered into the mod file. The FoldOperation(RankOneBoundElement)
+! helper tries to reduce that ROBE to an ordinary scalar element reference so
+! the mod file round-trips as valid Fortran instead of leaking the synthetic
+! `__builtin_rank1_bound_element(...)` spelling.
+!===============================================================================
+
+!-------------------------------------------------------------------------------
+! Reducible bases: the single ROBE collapses to a plain scalar element ref
+! (no __builtin_rank1_bound_element in the mod file).
+!-------------------------------------------------------------------------------
+
+! Whole array COMPONENT base -> reduces to x%c(2_8)
+module mcomp
+ type t
+ integer :: c(2)
+ end type
+contains
+ subroutine s(x, a, b)
+ type(t), intent(in) :: x
+ real :: a(x%c)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mcomp.mod
+!module mcomp
+!type::t
+!integer(4)::c(1_8:2_8)
+!end type
+!contains
+!subroutine s(x,a,b)
+!type(t),intent(in)::x
+!real(4)::a(1_8:__builtin_int(x%c,kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x%c(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Named-constant/PARAMETER array base -> extent folds to a constant
+module mparam
+ integer, parameter :: dims(2) = [5, 10]
+contains
+ subroutine s(a, b)
+ real :: a(dims)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mparam.mod
+!module mparam
+!integer(4),parameter::dims(1_8:2_8)=[INTEGER(4)::5_4,10_4]
+!contains
+!subroutine s(a,b)
+!real(4)::a(1_8:[INTEGER(8)::5_8,10_8])
+!real(4)::b(1_8:10_8)
+!end
+!end
+
+! Elementwise arithmetic base n+1 -> reduces to n(2_8)+1_4
+module marith_add
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(2)
+ real :: a(n+1)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: marith_add.mod
+!module marith_add
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(n+1_4,kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8)+1_4,kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Elementwise arithmetic base 2*n -> reduces to 2_4*n(2_8)
+module marith_mul
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(2)
+ real :: a(2*n)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: marith_mul.mod
+!module marith_mul
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(2_4*n,kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(2_4*n(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Explicit kind conversion base int(n,4) -> reduces through the Convert
+module mkindconv
+contains
+ subroutine s(n, a, b)
+ integer(8), intent(in) :: n(2)
+ real :: a(int(n,4))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mkindconv.mod
+!module mkindconv
+!contains
+!subroutine s(n,a,b)
+!integer(8),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(__builtin_int(n,kind=4),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(__builtin_int(n(2_8),kind=4),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Array SECTION base n(1:2) -> reduces to n(2_8)
+module msection
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(4)
+ real :: a(n(1:2))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: msection.mod
+!module msection
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:4_8)
+!real(4)::a(1_8:__builtin_int(n(1_8:2_8:1_8),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Array CONSTRUCTOR base [n(1),n(2)] -> reduces to n(2_8)
+module marrcons
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(2)
+ real :: a([n(1), n(2)])
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: marrcons.mod
+!module marrcons
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:[INTEGER(8)::__builtin_int(n(1_8),kind=8),__builtin_int(n(2_8),kind=8)])
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Elemental INTRINSIC base abs(n) -> reduces to abs(n(2_8))
+module melemintrin
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(2)
+ real :: a(abs(n))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: melemintrin.mod
+!module melemintrin
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(abs(n),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(abs(n(2_8)),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Array CONSTRUCTOR with an IMPLIED-DO base [(n(i),i=1,2)] -> reduces to n(2_8)
+module mimplieddo
+contains
+ subroutine s(n, a, b)
+ integer, intent(in) :: n(4)
+ real :: a([(n(i), i=1,2)])
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mimplieddo.mod
+!module mimplieddo
+!contains
+!subroutine s(n,a,b)
+!integer(4),intent(in)::n(1_8:4_8)
+!real(4)::a(1_8:__builtin_int([INTEGER(4)::(n(__builtin_int(__builtin_int(i,kind=4),kind=8)),INTEGER(8)::i=1_8,2_8,1_8)],kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+!-------------------------------------------------------------------------------
+! Not-yet-reduced bases that keep the ROBE wrapper: a ROBE IS formed, but the
+! helper can't distribute element extraction into the base, so the synthetic
+! `__builtin_rank1_bound_element(...)` spelling is emitted. This is the safe
+! fallback that makes the wrapper necessary -- it guarantees the mod file is
+! always emittable and round-trips even when reduction isn't possible. Here the
+! elemental intrinsic merge() has a LOGICAL mask argument, which the helper (it
+! only recurses into integer array arguments) does not reduce.
+!-------------------------------------------------------------------------------
+
+! Elemental intrinsic with a non-integer array arg -> wrapper is kept
+module mmergefallback
+contains
+ subroutine s(n, m, c, a, b)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(n, m, c))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mmergefallback.mod
+!module mmergefallback
+!contains
+!subroutine s(n,m,c,a,b)
+!integer(4),intent(in)::n(1_8:2_8)
+!integer(4),intent(in)::m(1_8:2_8)
+!logical(4),intent(in)::c(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(merge(n,m,c),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_rank1_bound_element(__builtin_int(merge(n,m,c),kind=8),dim=2)),kind=4),kind=8))
+!end
+!end
+
+!-------------------------------------------------------------------------------
+! Fundamentally irreducible bases: there is NO Fortran syntax to subscript a
+! single element of the base -- e.g. you cannot index a function result (gb()(2)
+! is not legal) -- so a ROBE over such a base could never be rendered as a
+! scalar element ref, even though the base itself is legal in a declaration.
+! Here ubound side-steps the problem entirely by folding to size(a,dim=2), so no
+! ROBE is ever formed.
+!-------------------------------------------------------------------------------
+
+! User/specification FUNCTION base -> ubound degrades to size(a,dim=2), so no
+! ROBE is ever formed (no __builtin_rank1_bound_element).
+module muserfunc
+contains
+ pure function gb() result(r)
+ integer :: r(2)
+ r = [3, 4]
+ end function
+ subroutine s(a, b)
+ real :: a(gb())
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: muserfunc.mod
+!module muserfunc
+!contains
+!pure function gb() result(r)
+!integer(4)::r(1_8:2_8)
+!end
+!subroutine s(a,b)
+!real(4)::a(1_8:__builtin_int(gb(),kind=8))
+!real(4)::b(1_8:size(a,dim=2,kind=8))
+!end
+!end
diff --git a/flang/test/Semantics/modfile-rank1-bound-element.f90 b/flang/test/Semantics/modfile-rank1-bound-element.f90
new file mode 100644
index 0000000000000..d596f4c5ecd2a
--- /dev/null
+++ b/flang/test/Semantics/modfile-rank1-bound-element.f90
@@ -0,0 +1,35 @@
+! Verify that a mod file which contains a __builtin_rank1_bound_element wrapper
+! can be read back in through USE from a *separate* compilation. The wrapper is
+! emitted for a rank-1 bound element that cannot be reduced to a plain scalar
+! reference (here the elemental intrinsic merge() has a LOGICAL mask argument,
+! which the reducer does not distribute into). It has no true Fortran surface
+! syntax and no backing intrinsic, so reading the mod file back in must rebuild
+! the RankOneBoundElement node from the wrapper call. The wrapper name must
+! also be spelled in lower case so it still matches after names are folded to
+! lower case when the mod file is read back in.
+!
+! The provider and consumer are compiled separately so that the USE genuinely
+! reads provider.mod from disk rather than reusing in-memory symbols.
+
+! RUN: rm -rf %t && mkdir -p %t
+! RUN: split-file %s %t
+! RUN: %flang_fc1 -fsyntax-only -J%t %t/provider.f90
+! RUN: %flang_fc1 -fsyntax-only -J%t %t/consumer.f90
+
+!--- provider.f90
+module m_rank1_bound_element_provider
+contains
+ subroutine s(n, m, c, a, b)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(n, m, c))
+ real :: b(ubound(a, 2))
+ b(1) = 1.0
+ a(1, 1) = b(1)
+ end subroutine
+end module
+
+!--- consumer.f90
+program p
+ use m_rank1_bound_element_provider
+end program
diff --git a/flang/test/Semantics/rank1-bound-element-symbols.f90 b/flang/test/Semantics/rank1-bound-element-symbols.f90
index 7839a06935a38..3b940d08c63b9 100644
--- a/flang/test/Semantics/rank1-bound-element-symbols.f90
+++ b/flang/test/Semantics/rank1-bound-element-symbols.f90
@@ -10,7 +10,7 @@
subroutine s(n)
integer, intent(in) :: n(3)
- !SYMBOLS: a {{.*}}: ObjectEntity type: REAL(4) shape: 1_8:rank1BoundElement(__builtin_int(n,kind=8),dim=1),1_8:rank1BoundElement(__builtin_int(n,kind=8),dim=2),1_8:rank1BoundElement(__builtin_int(n,kind=8),dim=3)
+ !SYMBOLS: a {{.*}}: ObjectEntity type: REAL(4) shape: 1_8:__builtin_rank1_bound_element(__builtin_int(n,kind=8),dim=1),1_8:__builtin_rank1_bound_element(__builtin_int(n,kind=8),dim=2),1_8:__builtin_rank1_bound_element(__builtin_int(n,kind=8),dim=3)
real :: a(n)
a = 0.0
end subroutine
>From b4b52b2f6abe9f63f52ceb64d428259b1e01c4c7 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 15 Sep 2026 18:57:57 -0500
Subject: [PATCH 3/6] Resolve minor merge conflict
---
flang/lib/Evaluate/intrinsics.cpp | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 4caa6339ecd57..0bd318fff41f7 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2975,7 +2975,7 @@ bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
// special cases
return name == "__builtin_c_loc" || name == "__builtin_c_devloc" ||
name == IntrinsicProcTable::BuiltinRank1BoundElementName ||
- name == "null";
+ name == "null" || name == "next" || name == "previous";
}
bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine(
const std::string &name0) const {
>From 0bb21d2cee40537c55b7250f8936d27067807cd1 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Thu, 17 Sep 2026 15:19:32 -0500
Subject: [PATCH 4/6] Address inefficient lowering. Add case that exercises
lowering __builtin_rank1_bound_element in the few cases that ROBE survives
Folding. Add cases that exercise other lowering paths.
---
flang/lib/Lower/ConvertVariable.cpp | 118 +++++++++++++++--
.../Lower/HLFIR/explicit-shape-bounds.f90 | 122 ++++++++++++++----
2 files changed, 207 insertions(+), 33 deletions(-)
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index a808905850922..0a3631a831247 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -11,6 +11,7 @@
//===----------------------------------------------------------------------===//
#include "flang/Lower/ConvertVariable.h"
+#include "flang/Evaluate/fold.h"
#include "flang/Lower/AbstractConverter.h"
#include "flang/Lower/Allocatable.h"
#include "flang/Lower/BoxAnalyzer.h"
@@ -1848,6 +1849,71 @@ static bool lowerToBoxValue(const Fortran::semantics::Symbol &sym,
return false;
}
+/// When every explicit bound on the requested side (lower or upper) of an
+/// array is a RankOneBoundElement, they all extract elements from the same
+/// rank-1 base expression -- that is how the front end builds them (see
+/// ArraySpecAnalyzer). Evaluate that base exactly once and return the
+/// per-dimension element values, converted to \p idxTy, so a call-valued base
+/// such as `mb(n)` in `real :: a(mb(n))` is not re-evaluated for every
+/// dimension. Returns an empty vector (so the caller lowers each bound
+/// independently) when the bounds are not rank-1 bound elements.
+static llvm::SmallVector<mlir::Value> lowerSharedRankOneBounds(
+ Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ const Fortran::lower::BoxAnalyzer &box, bool upper, mlir::Type idxTy,
+ Fortran::lower::SymMap &symMap, Fortran::lower::StatementContext &stmtCtx) {
+ const Fortran::evaluate::RankOneBoundElement *shared = nullptr;
+ for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
+ const Fortran::semantics::Bound &bound =
+ upper ? spec->ubound() : spec->lbound();
+ const auto &explicitBound = bound.GetExplicit();
+ if (!explicitBound)
+ return {};
+ if (const auto *robe = Fortran::evaluate::UnwrapExpr<
+ Fortran::evaluate::RankOneBoundElement>(*explicitBound)) {
+ if (!shared)
+ shared = robe;
+ } else {
+ return {};
+ }
+ }
+ if (!shared)
+ return {};
+ fir::FirOpBuilder &builder = converter.getFirOpBuilder();
+ Fortran::evaluate::FoldingContext &foldingContext =
+ converter.getFoldingContext();
+ // Build the shared rank-1 base at most once, and only if some dimension
+ // needs a runtime load: a constant base (e.g. a PARAMETER) folds to a
+ // compile-time scalar for each dimension instead.
+ std::optional<hlfir::Entity> baseArray;
+ llvm::SmallVector<mlir::Value> values;
+ for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
+ const Fortran::semantics::Bound &bound =
+ upper ? spec->ubound() : spec->lbound();
+ Fortran::lower::SomeExpr elemExpr{Fortran::evaluate::Fold(
+ foldingContext, Fortran::evaluate::AsGenericExpr(
+ Fortran::common::Clone(*bound.GetExplicit())))};
+ if (std::optional<int64_t> cst = Fortran::evaluate::ToInt64(elemExpr)) {
+ values.emplace_back(builder.createIntegerConstant(loc, idxTy, *cst));
+ continue;
+ }
+ if (!baseArray) {
+ Fortran::lower::SomeExpr baseExpr{Fortran::evaluate::AsGenericExpr(
+ Fortran::evaluate::Expr<Fortran::evaluate::SomeInteger>{
+ Fortran::common::Clone(shared->base())})};
+ baseArray = hlfir::Entity{Fortran::lower::convertExprToHLFIR(
+ loc, converter, baseExpr, symMap, stmtCtx)};
+ }
+ const auto *robe =
+ Fortran::evaluate::UnwrapExpr<Fortran::evaluate::RankOneBoundElement>(
+ *bound.GetExplicit());
+ mlir::Value idx =
+ builder.createIntegerConstant(loc, idxTy, robe->dimension() + 1);
+ mlir::Value elem = hlfir::loadElementAt(loc, builder, *baseArray, {idx});
+ values.emplace_back(builder.createConvert(loc, idxTy, elem));
+ }
+ return values;
+}
+
/// Lower explicit lower bounds into \p result. Does nothing if this is not an
/// array, or if the lower bounds are deferred, or all implicit or one.
static void lowerExplicitLowerBounds(
@@ -1864,6 +1930,12 @@ static void lowerExplicitLowerBounds(
result.emplace_back(builder.createIntegerConstant(loc, idxTy, lb));
return;
}
+ if (llvm::SmallVector<mlir::Value> shared = lowerSharedRankOneBounds(
+ converter, loc, box, /*upper=*/false, idxTy, symMap, stmtCtx);
+ !shared.empty()) {
+ result.append(shared.begin(), shared.end());
+ return;
+ }
for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
if (auto low = spec->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
@@ -1903,11 +1975,20 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
result.emplace_back(builder.createIntegerConstant(loc, idxTy, extent));
return;
}
+ // Rank-1 bound elements share one base; evaluate it once and reuse the
+ // extracted upper bound for every dimension's extent computation.
+ llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
+ converter, loc, box, /*upper=*/true, idxTy, symMap, stmtCtx);
for (const auto &spec : llvm::enumerate(box.dynamicBound())) {
if (auto up = spec.value()->ubound().GetExplicit()) {
- auto expr = Fortran::lower::SomeExpr{*up};
- mlir::Value ub = builder.createConvert(
- loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
+ mlir::Value ub;
+ if (!sharedUpper.empty()) {
+ ub = sharedUpper[spec.index()];
+ } else {
+ auto expr = Fortran::lower::SomeExpr{*up};
+ ub = builder.createConvert(
+ loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
+ }
if (lowerBounds.empty())
result.emplace_back(fir::factory::genMaxWithZero(builder, loc, ub));
else
@@ -2486,14 +2567,22 @@ void Fortran::lower::mapSymbolAttributes(
// The origin must be \vec{1}.
auto populateShape = [&](auto &shapes, const auto &bounds, mlir::Value box) {
+ // Rank-1 bound elements share one base; evaluate it once and reuse the
+ // extracted upper bound for every dimension (empty when not applicable).
+ llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
+ converter, loc, ba, /*upper=*/true, idxTy, symMap, stmtCtx);
for (auto iter : llvm::enumerate(bounds)) {
auto *spec = iter.value();
assert(spec->lbound().GetExplicit() &&
"lbound must be explicit with constant value 1");
if (auto high = spec->ubound().GetExplicit()) {
- Fortran::lower::SomeExpr highEx{*high};
- mlir::Value ub = genValue(highEx);
- ub = builder.createConvert(loc, idxTy, ub);
+ mlir::Value ub;
+ if (!sharedUpper.empty()) {
+ ub = sharedUpper[iter.index()];
+ } else {
+ Fortran::lower::SomeExpr highEx{*high};
+ ub = builder.createConvert(loc, idxTy, genValue(highEx));
+ }
shapes.emplace_back(fir::factory::genMaxWithZero(builder, loc, ub));
} else if (spec->ubound().isColon()) {
assert(box && "assumed bounds require a descriptor");
@@ -2513,6 +2602,13 @@ void Fortran::lower::mapSymbolAttributes(
// The origin is not \vec{1}.
auto populateLBoundsExtents = [&](auto &lbounds, auto &extents,
const auto &bounds, mlir::Value box) {
+ // Rank-1 bound elements share one base per side; evaluate each once and
+ // reuse the extracted bounds for every dimension (empty when not
+ // applicable).
+ llvm::SmallVector<mlir::Value> sharedLower = lowerSharedRankOneBounds(
+ converter, loc, ba, /*upper=*/false, idxTy, symMap, stmtCtx);
+ llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
+ converter, loc, ba, /*upper=*/true, idxTy, symMap, stmtCtx);
for (auto iter : llvm::enumerate(bounds)) {
auto *spec = iter.value();
fir::BoxDimsOp dimInfo;
@@ -2535,7 +2631,9 @@ void Fortran::lower::mapSymbolAttributes(
lbounds.emplace_back(builder.createIntegerConstant(loc, idxTy, 1));
}
} else {
- if (auto low = spec->lbound().GetExplicit()) {
+ if (!sharedLower.empty()) {
+ lb = sharedLower[iter.index()];
+ } else if (auto low = spec->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
lb = builder.createConvert(loc, idxTy, genValue(expr));
} else {
@@ -2543,7 +2641,11 @@ void Fortran::lower::mapSymbolAttributes(
}
lbounds.emplace_back(lb);
- if (auto high = spec->ubound().GetExplicit()) {
+ if (!sharedUpper.empty()) {
+ ub = sharedUpper[iter.index()];
+ extents.emplace_back(
+ fir::factory::computeExtent(builder, loc, lb, ub));
+ } else if (auto high = spec->ubound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*high};
ub = builder.createConvert(loc, idxTy, genValue(expr));
extents.emplace_back(
diff --git a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90 b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
index c022ec4214668..63f6ea59e68e7 100644
--- a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
+++ b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
@@ -1,9 +1,13 @@
! Test lowering of explicit-shape bounds using rank-1 integer arrays
-! (RankOneBoundElement in the evaluate representation).
+! (RankOneBoundElement in the evaluate representation). A constant base folds
+! to compile-time constants; otherwise the N bounds that share one rank-1 base
+! are lowered by evaluating that base exactly once and extracting each
+! dimension's element from it, rather than re-evaluating the base per dimension.
! RUN: bbc -emit-hlfir -o - %s 2>&1 | FileCheck %s
-! Test with PARAMETER rank-1 bounds: the constant array is folded so the
-! explicit-shape bounds become compile-time constants (no runtime load).
+! Test with PARAMETER rank-1 bounds: the shared constant array is folded, so
+! each dimension's bound is a compile-time constant and no base array is
+! materialized.
module test_param
contains
subroutine test_param_bounds()
@@ -13,11 +17,12 @@ subroutine test_param_bounds()
end subroutine
end module
! CHECK-LABEL: func.func @_QMtest_paramPtest_param_bounds()
+! CHECK-NOT: hlfir.designate
! CHECK: %[[C2:.*]] = arith.constant 2 : index
! CHECK: %[[C3:.*]] = arith.constant 3 : index
! CHECK: %[[C4:.*]] = arith.constant 4 : index
! CHECK: fir.alloca !fir.array<2x3x4xf32>
-! CHECK: fir.shape %[[C2]], %[[C3]], %[[C4]] : (index, index, index) -> !fir.shape<3>
+! CHECK: fir.shape %[[C2]], %[[C3]], %[[C4]]
! Test with rank-1 dummy as upper bounds only.
module test_dummy_upper
@@ -29,17 +34,17 @@ subroutine test_dummy_upper_bounds(n)
end subroutine
end module
! CHECK-LABEL: func.func @_QMtest_dummy_upperPtest_dummy_upper_bounds(
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<3xi64>
+! CHECK: %[[N:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<3xi64>
! CHECK: ^bb0(%arg{{.*}}: index):
! CHECK: hlfir.designate {{.*}} (%arg{{.*}}) : ({{.*}}, index) -> !fir.ref<i32>
! CHECK: fir.load {{.*}} : !fir.ref<i32>
! CHECK: fir.convert {{.*}} : (i32) -> i64
! CHECK: %[[C1:.*]] = arith.constant 1 : index
-! CHECK: hlfir.apply {{.*}}, %[[C1]] : (!hlfir.expr<3xi64>, index) -> i64
+! CHECK: hlfir.apply %[[N]], %[[C1]] : (!hlfir.expr<3xi64>, index) -> i64
! CHECK: %[[C2:.*]] = arith.constant 2 : index
-! CHECK: hlfir.apply {{.*}}, %[[C2]] : (!hlfir.expr<3xi64>, index) -> i64
+! CHECK: hlfir.apply %[[N]], %[[C2]] : (!hlfir.expr<3xi64>, index) -> i64
! CHECK: %[[C3:.*]] = arith.constant 3 : index
-! CHECK: hlfir.apply {{.*}}, %[[C3]] : (!hlfir.expr<3xi64>, index) -> i64
+! CHECK: hlfir.apply %[[N]], %[[C3]] : (!hlfir.expr<3xi64>, index) -> i64
! Test with both lower and upper rank-1 bounds.
module test_dummy_both
@@ -51,18 +56,16 @@ subroutine test_dummy_both_bounds(lb, ub)
end subroutine
end module
! CHECK-LABEL: func.func @_QMtest_dummy_bothPtest_dummy_both_bounds(
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
-! CHECK: %[[C1:.*]] = arith.constant 1 : index
-! CHECK: hlfir.apply {{.*}}, %[[C1]] : (!hlfir.expr<2xi64>, index) -> i64
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
-! CHECK: %[[C1_1:.*]] = arith.constant 1 : index
-! CHECK: hlfir.apply {{.*}}, %[[C1_1]] : (!hlfir.expr<2xi64>, index) -> i64
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
-! CHECK: %[[C2:.*]] = arith.constant 2 : index
-! CHECK: hlfir.apply {{.*}}, %[[C2]] : (!hlfir.expr<2xi64>, index) -> i64
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
-! CHECK: %[[C2_1:.*]] = arith.constant 2 : index
-! CHECK: hlfir.apply {{.*}}, %[[C2_1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[LB:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[L1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply %[[LB]], %[[L1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[L2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply %[[LB]], %[[L2]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[UB:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[U1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply %[[UB]], %[[U1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[U2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply %[[UB]], %[[U2]] : (!hlfir.expr<2xi64>, index) -> i64
! Test broadcast of scalar lower bound with rank-1 upper bounds.
module test_broadcast
@@ -74,11 +77,11 @@ subroutine test_broadcast_bounds(ub)
end subroutine
end module
! CHECK-LABEL: func.func @_QMtest_broadcastPtest_broadcast_bounds(
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[UB:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
! CHECK: %[[U1:.*]] = arith.constant 1 : index
-! CHECK: hlfir.apply {{.*}}, %[[U1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.apply %[[UB]], %[[U1]] : (!hlfir.expr<2xi64>, index) -> i64
! CHECK: %[[U2:.*]] = arith.constant 2 : index
-! CHECK: hlfir.apply {{.*}}, %[[U2]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.apply %[[UB]], %[[U2]] : (!hlfir.expr<2xi64>, index) -> i64
! CHECK: fir.shape_shift {{.*}} : (index, index, index, index) -> !fir.shapeshift<2>
! Test rank-1 dummy bounds of explicit integer kinds: the bound base is always
@@ -96,9 +99,78 @@ subroutine test_bound_kinds_bounds(n4, n8)
end subroutine
end module
! CHECK-LABEL: func.func @_QMtest_bound_kindsPtest_bound_kinds_bounds(
-! CHECK: hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[N8:.*]]:2 = hlfir.declare %arg1{{.*}}n8"} : (!fir.ref<!fir.array<2xi64>>{{.*}}
+! CHECK: %[[A4:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
! CHECK: hlfir.designate {{.*}} (%arg{{.*}}) : ({{.*}}, index) -> !fir.ref<i32>
! CHECK: fir.load {{.*}} : !fir.ref<i32>
! CHECK: fir.convert {{.*}} : (i32) -> i64
-! CHECK: hlfir.designate {{.*}} : ({{.*}}, index) -> !fir.ref<i64>
+! CHECK: hlfir.apply %[[A4]], %{{.*}} : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.apply %[[A4]], %{{.*}} : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: hlfir.designate %[[N8]]#0 (%{{.*}}){{.*}}-> !fir.ref<i64>
+! CHECK: fir.load {{.*}} : !fir.ref<i64>
+! CHECK: hlfir.designate %[[N8]]#0 (%{{.*}}){{.*}}-> !fir.ref<i64>
! CHECK: fir.load {{.*}} : !fir.ref<i64>
+
+! Test a polymorphic explicit-shape dummy: it is tracked through a descriptor,
+! so the rank-1 upper bounds are lowered on the descriptor path (via
+! lowerExplicitExtents) rather than the plain-array path. The shared base is
+! still evaluated once.
+module test_poly_upper
+contains
+ subroutine test_poly_upper_bounds(n, a)
+ integer, intent(in) :: n(3)
+ class(*), intent(in) :: a(n)
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_poly_upperPtest_poly_upper_bounds(
+! CHECK: %[[N:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<3xi64>
+! CHECK: hlfir.designate {{.*}} (%arg{{.*}}) : ({{.*}}, index) -> !fir.ref<i32>
+! CHECK: fir.load {{.*}} : !fir.ref<i32>
+! CHECK: fir.convert {{.*}} : (i32) -> i64
+! CHECK-NOT: hlfir.elemental
+! CHECK: hlfir.declare %arg1 {{.*}}!fir.class
+! CHECK: hlfir.destroy %[[N]]
+
+! Test a polymorphic explicit-shape dummy with rank-1 lower and upper bounds:
+! the descriptor path uses lowerExplicitLowerBounds and lowerExplicitExtents.
+! Each side's shared base is evaluated once; the lower bounds feed fir.shift.
+module test_poly_both
+contains
+ subroutine test_poly_both_bounds(lb, ub, a)
+ integer, intent(in) :: lb(2), ub(2)
+ class(*), intent(in) :: a(lb:ub)
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_poly_bothPtest_poly_both_bounds(
+! CHECK: %[[LB:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[L1:.*]] = arith.constant 1 : index
+! CHECK: hlfir.apply %[[LB]], %[[L1]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[L2:.*]] = arith.constant 2 : index
+! CHECK: hlfir.apply %[[LB]], %[[L2]] : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: %[[UB:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: fir.shift {{.*}} : (index, index) -> !fir.shift<2>
+! CHECK: hlfir.declare %arg2{{.*}}!fir.class
+
+! Test a bound that embeds a rank-1 bound element inside other operations: the
+! upper bound of `b` is ubound(a,2), and `a`'s base merge(n,m,c) is irreducible
+! (logical mask), so the front end keeps the bound element wrapped in
+! int(int(max(0, ROBE), 4), 8). The shared-bound helper only matches a bound
+! that is a bare rank-1 bound element, so this one falls back to generic
+! expression lowering, which re-evaluates the base and extracts the element.
+module test_ubound_robe
+contains
+ subroutine test_ubound_robe_bounds(n, m, c)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(n, m, c))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = 1.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_ubound_robePtest_ubound_robe_bounds(
+! CHECK: hlfir.declare {{.*}}Ea"
+! CHECK: %[[UBBASE:.*]] = hlfir.elemental {{.*}} -> !hlfir.expr<2xi64>
+! CHECK: %[[UBELT:.*]] = hlfir.apply %[[UBBASE]], %{{.*}} : (!hlfir.expr<2xi64>, index) -> i64
+! CHECK: arith.maxsi %{{.*}}, %[[UBELT]]
+! CHECK: hlfir.declare {{.*}}Eb"
>From fc7aac94fa7a70804d80a7e66101b1e10c79270b Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sat, 19 Sep 2026 12:56:17 -0500
Subject: [PATCH 5/6] Fix incorrect subscripting by detecting the ONLY part-ref
that is nonzero rank (as per C919), ensure full generality by allowing
arbitrary "distance" (nested member accesses, aka an access chain like
a%b%c%d) between the end of the expression and the member that is nonzero
rank. Also add support for reducing arrays formed by using vector subscripts
instead of letting it fallback to the __builtin ROBE wrapper.
---
flang/lib/Evaluate/fold-integer.cpp | 170 +++++++++++++-----
.../modfile-explicit-shape-bounds.f90 | 161 +++++++++++++++++
.../Semantics/rank1-bound-element-symbols.f90 | 14 ++
3 files changed, 297 insertions(+), 48 deletions(-)
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 04add1a1acce1..2a4a74d7f976f 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1570,6 +1570,124 @@ Expr<TypeParamInquiry::Result> FoldOperation(
return AsExpr(std::move(inquiry));
}
+template <int KIND>
+static std::optional<Expr<Type<TypeCategory::Integer, KIND>>>
+ExtractRankOneElement(FoldingContext &context,
+ const Expr<Type<TypeCategory::Integer, KIND>> &base, int dim);
+
+// Subscripts `entity`, whose last part-ref is the rank>0 array, at element
+// [dim] (0-based) using its lower bound.
+static std::optional<DataRef> SubscriptArrayPartRef(
+ FoldingContext &context, NamedEntity &&entity, int dim) {
+ MaybeExtentExpr lb{GetLBOUND(context, entity, /*dim=*/0)};
+ if (!lb) {
+ return std::nullopt;
+ }
+ std::vector<Subscript> ss;
+ ss.emplace_back(Fold(context, std::move(*lb) + Expr<SubscriptInteger>{dim}));
+ return DataRef{ArrayRef{std::move(entity), std::move(ss)}};
+}
+
+// Builds the rank-0 DataRef for element [dim] (0-based) of a rank-1 designator
+// by subscripting its sole array part-ref (C919) at lbound+dim, leaving every
+// scalar part-ref -- including scalar-subscripted array parts anywhere in the
+// chain -- intact. Handles whole arrays, array/scalar components, a single
+// triplet section (element l+dim*s), and arbitrary nesting such as
+// x(1)%c%d(3)%e -> x(1)%c(dim)%d(3)%e. A vector subscript n(V) yields
+// n(element[dim] of V) when V itself reduces. Null when the array part is a
+// coarray, or a vector subscript whose index expression cannot be reduced.
+static std::optional<DataRef> SubscriptRankOneElement(
+ FoldingContext &context, const DataRef &dr, int dim) {
+ return common::visit(
+ common::visitors{
+ [&](const SymbolRef &s) -> std::optional<DataRef> {
+ if (s->Rank() == 0) {
+ return std::nullopt;
+ }
+ return SubscriptArrayPartRef(context, NamedEntity{s.get()}, dim);
+ },
+ [&](const Component &c) -> std::optional<DataRef> {
+ if (c.GetLastSymbol().Rank() > 0) {
+ return SubscriptArrayPartRef(
+ context, NamedEntity{Component{c}}, dim);
+ }
+ // Scalar component: the array part is in the base.
+ if (auto base{SubscriptRankOneElement(context, c.base(), dim)}) {
+ return DataRef{Component{std::move(*base), c.GetLastSymbol()}};
+ }
+ return std::nullopt;
+ },
+ [&](const ArrayRef &a) -> std::optional<DataRef> {
+ int nonScalar{0}, nonScalarDim{-1};
+ for (int j{0}; j < a.size(); ++j) {
+ if (std::holds_alternative<Triplet>(a.at(j).u) ||
+ a.at(j).Rank() != 0) {
+ ++nonScalar;
+ nonScalarDim = j;
+ }
+ }
+ if (nonScalar > 1) {
+ return std::nullopt;
+ }
+ if (nonScalar == 1) {
+ // One rank-contributing subscript carries the whole rank (C919).
+ // A triplet l:u:s yields element l+dim*s; a vector subscript V
+ // yields the scalar n(element[dim] of V); scalars are kept.
+ std::vector<Subscript> ss;
+ for (int j{0}; j < a.size(); ++j) {
+ const Subscript &sub{a.at(j)};
+ if (j != nonScalarDim) {
+ ss.emplace_back(sub);
+ } else if (const auto *trip{std::get_if<Triplet>(&sub.u)}) {
+ std::optional<Expr<SubscriptInteger>> lower;
+ if (const auto *lo{trip->GetLower()}) {
+ lower = *lo;
+ } else if (auto lb{GetLBOUND(context, a.base(), j)}) {
+ lower = std::move(*lb);
+ } else {
+ return std::nullopt;
+ }
+ ss.emplace_back(Fold(context,
+ std::move(*lower) +
+ Expr<SubscriptInteger>{dim} * trip->stride()));
+ } else {
+ const auto &vec{
+ std::get<IndirectSubscriptIntegerExpr>(sub.u).value()};
+ if (auto elem{ExtractRankOneElement(context, vec, dim)}) {
+ ss.emplace_back(std::move(*elem));
+ } else {
+ return std::nullopt;
+ }
+ }
+ }
+ return DataRef{ArrayRef{NamedEntity{a.base()}, std::move(ss)}};
+ }
+ // All-scalar subscripts: the rank comes from the base component's
+ // parent (ArrayRef::Rank). Recurse through the base to the array
+ // part-ref, then rebuild these subscripts on the element.
+ const Component *comp{a.base().UnwrapComponent()};
+ if (!comp) {
+ return std::nullopt;
+ }
+ if (auto base{
+ SubscriptRankOneElement(context, comp->base(), dim)}) {
+ std::vector<Subscript> ss;
+ for (int j{0}; j < a.size(); ++j) {
+ ss.emplace_back(a.at(j));
+ }
+ return DataRef{ArrayRef{NamedEntity{Component{std::move(*base),
+ comp->GetLastSymbol()}},
+ std::move(ss)}};
+ }
+ return std::nullopt;
+ },
+ [&](const CoarrayRef &) -> std::optional<DataRef> {
+ return std::nullopt;
+ },
+ },
+ dr.u);
+}
+
// Extract element [dim] (0-based, array-element order) from a rank-1 integer
// array expression as a scalar, distributing the extraction through kind
// conversions, elementwise integer operations, and elemental intrinsic calls,
@@ -1593,54 +1711,10 @@ ExtractRankOneElement(FoldingContext &context,
at[0] = y.lbounds()[0] + dim;
return Expr<T>{Constant<T>{y.At(at)}};
} else if constexpr (std::is_same_v<Ty, Designator<T>>) {
- if (auto named{ExtractNamedEntity(Expr<T>{y})}) {
- // Whole array or component: element [dim] is base(lbound+dim).
- if (MaybeExtentExpr lb{GetLBOUND(context, *named, /*dim=*/0)}) {
- Expr<SubscriptInteger> at{
- Fold(context, std::move(*lb) + Expr<SubscriptInteger>{dim})};
- std::vector<Subscript> ss;
- ss.emplace_back(std::move(at));
- ArrayRef ref{std::move(*named), std::move(ss)};
- if (auto elem{AsGenericExpr(DataRef{std::move(ref)})}) {
- if (auto *ie{UnwrapExpr<Expr<SomeInteger>>(*elem)}) {
- return ConvertToType<T>(std::move(*ie));
- }
- }
- }
- } else if (const auto *aref{std::get_if<ArrayRef>(&y.u)}) {
- // Array section base(l:u:s): element [dim] is base(l+dim*s).
- std::vector<Subscript> ss;
- bool built{false}, ok{true};
- for (int j{0}; ok && j < aref->size(); ++j) {
- const Subscript &sub{aref->at(j)};
- if (const auto *trip{std::get_if<Triplet>(&sub.u)}) {
- if (built) { // only one rank-1 triplet is expected
- ok = false;
- break;
- }
- std::optional<Expr<SubscriptInteger>> lower;
- if (const auto *lo{trip->GetLower()}) {
- lower = *lo;
- } else if (auto lb{GetLBOUND(context, aref->base(), j)}) {
- lower = std::move(*lb);
- } else {
- ok = false;
- break;
- }
- ss.emplace_back(Fold(context,
- std::move(*lower) +
- Expr<SubscriptInteger>{dim} * trip->stride()));
- built = true;
- } else if (sub.Rank() == 0) {
- ss.emplace_back(sub);
- } else {
- ok = false; // vector subscript: not handled here
- }
- }
- if (ok && built) {
- ArrayRef ref{NamedEntity{aref->base()}, std::move(ss)};
- if (auto elem{AsGenericExpr(DataRef{std::move(ref)})}) {
- if (auto *ie{UnwrapExpr<Expr<SomeInteger>>(*elem)}) {
+ if (auto dr{ExtractDataRef(y)}) {
+ if (auto elem{SubscriptRankOneElement(context, *dr, dim)}) {
+ if (auto expr{AsGenericExpr(std::move(*elem))}) {
+ if (auto *ie{UnwrapExpr<Expr<SomeInteger>>(*expr)}) {
return ConvertToType<T>(std::move(*ie));
}
}
diff --git a/flang/test/Semantics/modfile-explicit-shape-bounds.f90 b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
index 16b8ea668998b..1ee49d9e4e74d 100644
--- a/flang/test/Semantics/modfile-explicit-shape-bounds.f90
+++ b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
@@ -157,6 +157,115 @@ subroutine s(x, a, b)
!end
!end
+! Scalar COMPONENT of an array parent base -> the element subscript lands on the
+! parent, reducing to x(2_8)%c (not the rank-retaining x%c(2_8))
+module mcompparent
+ type t
+ integer :: c
+ end type
+contains
+ subroutine s(x, a, b)
+ type(t), intent(in) :: x(2)
+ real :: a(x%c)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mcompparent.mod
+!module mcompparent
+!type::t
+!integer(4)::c
+!end type
+!contains
+!subroutine s(x,a,b)
+!type(t),intent(in)::x(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(x%c,kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x(2_8)%c,kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Two part-refs, one scalar-subscripted so exactly one has nonzero rank (C919),
+! reduced from either side to x(3_8)%c(2_8). a2's array part is the component c,
+! so ubound(a2,2) subscripts it; a1's array part is the parent x, reached
+! through the component's all-scalar ArrayRef subscripts.
+module mcompboth
+ type t
+ integer :: c(2)
+ end type
+contains
+ subroutine s(x, a1, a2, b1, b2)
+ type(t), intent(in) :: x(3)
+ real :: a1(x%c(2))
+ real :: a2(x(3)%c)
+ real :: b1(ubound(a1,3))
+ real :: b2(ubound(a2,2))
+ b1(1) = 1.0
+ b2(1) = 1.0
+ a1(1,1,1) = b1(1)
+ a2(1,1) = b2(1)
+ end subroutine
+end module
+
+!Expect: mcompboth.mod
+!module mcompboth
+!type::t
+!integer(4)::c(1_8:2_8)
+!end type
+!contains
+!subroutine s(x,a1,a2,b1,b2)
+!type(t),intent(in)::x(1_8:3_8)
+!real(4)::a1(1_8:__builtin_int(x%c(2_8),kind=8))
+!real(4)::a2(1_8:__builtin_int(x(3_8)%c,kind=8))
+!real(4)::b1(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x(3_8)%c(2_8),kind=8)),kind=4),kind=8))
+!real(4)::b2(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x(3_8)%c(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Arbitrary DataRef nesting: the single array part-ref (unsubscripted c(3),
+! per C919 the only nonzero-rank part-ref) is subscripted at element [dim],
+! scalar components/subscripts above and below it are rebuilt, reducing
+! ubound(a,2) to x(1_8)%c(2_8)%d(3_8)%e.
+module mnested
+ type t3
+ integer :: e
+ end type
+ type t2
+ type(t3) :: d(4)
+ end type
+ type t1
+ type(t2) :: c(3)
+ end type
+contains
+ subroutine s(x, a, b)
+ type(t1), intent(in) :: x(2)
+ real :: a(x(1)%c%d(3)%e)
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mnested.mod
+!module mnested
+!type::t3
+!integer(4)::e
+!end type
+!type::t2
+!type(t3)::d(1_8:4_8)
+!end type
+!type::t1
+!type(t2)::c(1_8:3_8)
+!end type
+!contains
+!subroutine s(x,a,b)
+!type(t1),intent(in)::x(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(x(1_8)%c%d(3_8)%e,kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x(1_8)%c(2_8)%d(3_8)%e,kind=8)),kind=4),kind=8))
+!end
+!end
+
! Named-constant/PARAMETER array base -> extent folds to a constant
module mparam
integer, parameter :: dims(2) = [5, 10]
@@ -267,6 +376,58 @@ subroutine s(n, a, b)
!end
!end
+! Vector-subscripted array base n(idx) -> element [dim] of n(idx) is
+! n(idx(dim)), so the vector subscript's own element reduction is substituted
+! back in, reducing to n(idx(2_8))
+module mvecsub
+contains
+ subroutine s(n, idx, a, b)
+ integer, intent(in) :: n(4)
+ integer, intent(in) :: idx(2)
+ real :: a(n(idx))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mvecsub.mod
+!module mvecsub
+!contains
+!subroutine s(n,idx,a,b)
+!integer(4),intent(in)::n(1_8:4_8)
+!integer(4),intent(in)::idx(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(n(__builtin_int(idx,kind=8)),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(__builtin_int(idx(2_8),kind=8)),kind=8)),kind=4),kind=8))
+!end
+!end
+
+! Vector subscript over an elementwise expression n(idx+1) -> the inner index
+! reduces through the full element reducer (idx+1 -> idx(2_8)+1_4), giving
+! n(idx(2_8)+1_4)
+module mvecsubexpr
+contains
+ subroutine s(n, idx, a, b)
+ integer, intent(in) :: n(4)
+ integer, intent(in) :: idx(2)
+ real :: a(n(idx + 1))
+ real :: b(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mvecsubexpr.mod
+!module mvecsubexpr
+!contains
+!subroutine s(n,idx,a,b)
+!integer(4),intent(in)::n(1_8:4_8)
+!integer(4),intent(in)::idx(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(n(__builtin_int(idx+1_4,kind=8)),kind=8))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(__builtin_int(idx(2_8)+1_4,kind=8)),kind=8)),kind=4),kind=8))
+!end
+!end
+
! Array CONSTRUCTOR base [n(1),n(2)] -> reduces to n(2_8)
module marrcons
contains
diff --git a/flang/test/Semantics/rank1-bound-element-symbols.f90 b/flang/test/Semantics/rank1-bound-element-symbols.f90
index 3b940d08c63b9..2de10b99eb5a6 100644
--- a/flang/test/Semantics/rank1-bound-element-symbols.f90
+++ b/flang/test/Semantics/rank1-bound-element-symbols.f90
@@ -22,6 +22,20 @@ subroutine s2
integer, dimension(5) :: z(1 : [integer ::])
end
+subroutine s3(x)
+ type t
+ integer :: c
+ end type
+ type(t), intent(in) :: x(2)
+ ! When a scalar component follows the array parent, the extracted element
+ ! subscript must land on the parent (x(2)%c) so the bound stays scalar and b
+ ! is rank one; subscripting the component (x%c(2)) would retain rank one and
+ ! make b rank two.
+ !SYMBOLS: b {{.*}}: ObjectEntity type: REAL(4) shape: 1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(x(2_8)%c,kind=8)),kind=4),kind=8)
+ real :: a(x%c), b(ubound(a, 2))
+ b = 0.0
+end subroutine
+
! -fdebug-unparse-with-symbols intentionally reproduces the original bound syntax
! rather than the synthesized rank1BoundElement node; this confirms the construct
! still round-trips through that action with its symbol annotations.
>From 26f3b3fa84536a4476c3eec5795116728ad8994a Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sat, 19 Sep 2026 12:59:26 -0500
Subject: [PATCH 6/6] Parallel changes in ConvertCall.cpp to reuse the base of
a set of rank-1 integer array bounds instead of re-evaluating the function
for every dimension.
---
flang/include/flang/Lower/ConvertVariable.h | 11 ++++++
flang/lib/Lower/ConvertCall.cpp | 20 +++++++----
flang/lib/Lower/ConvertVariable.cpp | 29 +++++++++++++++
.../Lower/HLFIR/explicit-shape-bounds.f90 | 35 +++++++++++++++++++
4 files changed, 89 insertions(+), 6 deletions(-)
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index a4ad984579410..883684ef00e73 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -120,6 +120,17 @@ void mapCallInterfaceSymbolsForDummyArgument(
AbstractConverter &, const Fortran::lower::CallerInterface &caller,
SymMap &symMap, const Fortran::semantics::Symbol &dummySymbol);
+/// Lower the extents of an explicit-shape function-call result, evaluating any
+/// rank-1 bound base (e.g. `mb(n)` in `res(mb(n))`) exactly once rather than
+/// once per dimension. Interface symbols appearing in the result spec
+/// expressions must already be mapped in \p symMap. Returns an empty vector
+/// when the result is not an explicit-shape array with rank-1 bounds, so the
+/// caller falls back to its per-dimension extent lowering.
+llvm::SmallVector<mlir::Value>
+lowerExplicitResultExtents(AbstractConverter &, mlir::Location,
+ const Fortran::semantics::Symbol &result,
+ SymMap &symMap, StatementContext &stmtCtx);
+
// TODO: consider saving the initial expression symbol dependence analysis in
// in the PFT variable and dealing with the dependent symbols instantiation in
// the fir::GlobalOp body at the fir::GlobalOp creation point rather than by
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 19678e429249b..c1191aac94f3e 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -425,12 +425,20 @@ Fortran::lower::genCallOpAndResult(
if (!caller.callerAllocateResult())
return {};
mlir::Type type = caller.getResultStorageType();
- if (mlir::isa<fir::SequenceType>(type))
- caller.walkResultExtents(
- [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
- assert(!isAssumedSizeExtent && "result cannot be assumed-size");
- extents.emplace_back(lowerSpecExpr(e));
- });
+ if (mlir::isa<fir::SequenceType>(type)) {
+ // Rank-1 bound elements share one base; evaluate it once for all
+ // dimensions instead of re-evaluating a call-valued base per extent.
+ if (const Fortran::semantics::SubprogramDetails *ifaceDetails =
+ caller.getInterfaceDetails())
+ extents = Fortran::lower::lowerExplicitResultExtents(
+ converter, loc, ifaceDetails->result(), symMap, stmtCtx);
+ if (extents.empty())
+ caller.walkResultExtents(
+ [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
+ assert(!isAssumedSizeExtent && "result cannot be assumed-size");
+ extents.emplace_back(lowerSpecExpr(e));
+ });
+ }
if (resultLengths.empty()) {
caller.walkResultLengths(
[&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 0a3631a831247..7ebe0221e7449 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -2001,6 +2001,35 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
assert(result.empty() || result.size() == box.dynamicBound().size());
}
+llvm::SmallVector<mlir::Value> Fortran::lower::lowerExplicitResultExtents(
+ Fortran::lower::AbstractConverter &converter, mlir::Location loc,
+ const Fortran::semantics::Symbol &result, Fortran::lower::SymMap &symMap,
+ Fortran::lower::StatementContext &stmtCtx) {
+ Fortran::lower::BoxAnalyzer box;
+ box.analyze(result);
+ llvm::SmallVector<mlir::Value> extents;
+ if (!box.isArray() || box.isStaticArray())
+ return extents;
+ // Only divert from the caller's default per-dimension extent lowering when a
+ // rank-1 bound base (e.g. mb(n) in res(mb(n))) would otherwise be
+ // re-evaluated once per dimension; lowerExplicitExtents evaluates it once.
+ bool hasRankOneBound = false;
+ for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound())
+ for (const Fortran::semantics::Bound &bound :
+ {std::cref(spec->lbound()), std::cref(spec->ubound())})
+ if (const auto &explicitBound = bound.GetExplicit())
+ if (Fortran::evaluate::UnwrapExpr<
+ Fortran::evaluate::RankOneBoundElement>(*explicitBound))
+ hasRankOneBound = true;
+ if (!hasRankOneBound)
+ return extents;
+ llvm::SmallVector<mlir::Value> lowerBounds;
+ lowerExplicitLowerBounds(converter, loc, box, lowerBounds, symMap, stmtCtx);
+ lowerExplicitExtents(converter, loc, box, lowerBounds, extents, symMap,
+ stmtCtx);
+ return extents;
+}
+
/// Lower explicit character length if any. Return empty mlir::Value if no
/// explicit length.
static mlir::Value
diff --git a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90 b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
index 63f6ea59e68e7..b5ce4cc111985 100644
--- a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
+++ b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
@@ -174,3 +174,38 @@ subroutine test_ubound_robe_bounds(n, m, c)
! CHECK: %[[UBELT:.*]] = hlfir.apply %[[UBBASE]], %{{.*}} : (!hlfir.expr<2xi64>, index) -> i64
! CHECK: arith.maxsi %{{.*}}, %[[UBELT]]
! CHECK: hlfir.declare {{.*}}Eb"
+
+! Caller side: a function whose result shape is a rank-1 base, res(mb(n)). When
+! allocating the result at the call site, the shared base mb(n) is evaluated
+! once and each dimension's extent is extracted from it, rather than calling
+! mb(n) once per result dimension.
+module test_result_robe
+contains
+ pure function mb(n) result(r)
+ integer, intent(in) :: n
+ integer :: r(3)
+ r = [n, n + 1, n + 2]
+ end function
+ function f(n) result(res)
+ integer, intent(in) :: n
+ real :: res(mb(n))
+ res = 0.0
+ end function
+ subroutine test_result_robe_caller(n, y)
+ integer, intent(in) :: n
+ real, allocatable :: y(:,:,:)
+ y = f(n)
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_result_robePtest_result_robe_caller(
+! CHECK: hlfir.eval_in_mem shape %{{.*}} -> !hlfir.expr<3xi32> {
+! CHECK: fir.call @_QMtest_result_robePmb(
+! CHECK: }
+! CHECK: %[[CONV:.*]] = hlfir.elemental %{{.*}} -> !hlfir.expr<?xi64>
+! CHECK: hlfir.apply %[[CONV]], %{{.*}} : (!hlfir.expr<?xi64>, index) -> i64
+! CHECK-NOT: fir.call @_QMtest_result_robePmb(
+! CHECK: hlfir.apply %[[CONV]], %{{.*}} : (!hlfir.expr<?xi64>, index) -> i64
+! CHECK: hlfir.apply %[[CONV]], %{{.*}} : (!hlfir.expr<?xi64>, index) -> i64
+! CHECK: fir.shape %{{.*}}, %{{.*}}, %{{.*}} : (index, index, index) -> !fir.shape<3>
+! CHECK: fir.call @_QMtest_result_robePf(
+
More information about the flang-commits
mailing list