[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
Tue Oct 13 17:57:29 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/8] [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/8] 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/8] 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/8] 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/8] 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/8] 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(
+
>From 14764c2f9b5883a5cb3f7f51590178823747f606 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 21 Sep 2026 01:33:33 -0500
Subject: [PATCH 7/8] Address inefficient lowering for scalar broadcast and
polymorphic argument remapping
---
flang/include/flang/Lower/ConvertVariable.h | 17 ++--
flang/lib/Lower/ConvertCall.cpp | 20 +++--
flang/lib/Lower/ConvertVariable.cpp | 79 ++++++++++++++++---
.../Lower/HLFIR/explicit-shape-bounds.f90 | 57 ++++++++++++-
4 files changed, 146 insertions(+), 27 deletions(-)
diff --git a/flang/include/flang/Lower/ConvertVariable.h b/flang/include/flang/Lower/ConvertVariable.h
index e58b0ffd11236..af2c9e572e46b 100644
--- a/flang/include/flang/Lower/ConvertVariable.h
+++ b/flang/include/flang/Lower/ConvertVariable.h
@@ -120,15 +120,16 @@ 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.
+/// Lower the extents of an explicit-shape call-interface entity (a function
+/// result or a sequence-associated array dummy), 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 entity's spec expressions must
+/// already be mapped in \p symMap. Returns an empty vector when the entity 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,
+lowerExplicitMappedExtents(AbstractConverter &, mlir::Location,
+ const Fortran::semantics::Symbol &symbol,
SymMap &symMap, StatementContext &stmtCtx);
// TODO: consider saving the initial expression symbol dependence analysis in
diff --git a/flang/lib/Lower/ConvertCall.cpp b/flang/lib/Lower/ConvertCall.cpp
index 9f05c0d468485..97a4937f1d927 100644
--- a/flang/lib/Lower/ConvertCall.cpp
+++ b/flang/lib/Lower/ConvertCall.cpp
@@ -198,11 +198,19 @@ static mlir::Value remapActualToDummyDescriptor(
llvm::SmallVector<mlir::Value> lengths;
mlir::Type dummyBoxType = caller.getDummyArgumentType(arg);
mlir::Type dummyBaseType = fir::unwrapPassByRefType(dummyBoxType);
- if (mlir::isa<fir::SequenceType>(dummyBaseType))
- caller.walkDummyArgumentExtents(
- arg, [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
- extents.emplace_back(lowerSpecExpr(e, isAssumedSizeExtent));
- });
+ if (mlir::isa<fir::SequenceType>(dummyBaseType)) {
+ // 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::Symbol *dummySym = caller.getDummySymbol(arg))
+ extents = Fortran::lower::lowerExplicitMappedExtents(
+ converter, loc, *dummySym, symMap, localStmtCtx);
+ if (extents.empty())
+ caller.walkDummyArgumentExtents(
+ arg,
+ [&](const Fortran::lower::SomeExpr &e, bool isAssumedSizeExtent) {
+ extents.emplace_back(lowerSpecExpr(e, isAssumedSizeExtent));
+ });
+ }
mlir::Value shape;
if (!extents.empty()) {
if (isBindcCall) {
@@ -430,7 +438,7 @@ Fortran::lower::genCallOpAndResult(
// dimensions instead of re-evaluating a call-valued base per extent.
if (const Fortran::semantics::SubprogramDetails *ifaceDetails =
caller.getInterfaceDetails())
- extents = Fortran::lower::lowerExplicitResultExtents(
+ extents = Fortran::lower::lowerExplicitMappedExtents(
converter, loc, ifaceDetails->result(), symMap, stmtCtx);
if (extents.empty())
caller.walkResultExtents(
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 1e0dc4e68c164..627473cec45b3 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1936,6 +1936,22 @@ static llvm::SmallVector<mlir::Value> lowerSharedRankOneBounds(
return values;
}
+/// True when any dimension's explicit bound is a rank-1 bound element, i.e. the
+/// array's rank was produced by expanding a rank-1 integer bound. In that case
+/// a non-ROBE bound in a given direction is a single user-written scalar that
+/// the front end clones into every dimension's ShapeSpec, so it can be
+/// evaluated once and reused instead of once per dimension.
+static bool hasRankOneBoundElement(const Fortran::lower::BoxAnalyzer &box) {
+ 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))
+ return true;
+ return false;
+}
+
/// 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(
@@ -1958,6 +1974,18 @@ static void lowerExplicitLowerBounds(
result.append(shared.begin(), shared.end());
return;
}
+ // A non-ROBE lower bound in a rank-1-bound-expanded array is a single scalar
+ // broadcast across every dimension; evaluate it once and reuse it.
+ if (hasRankOneBoundElement(box)) {
+ const Fortran::semantics::ShapeSpec *spec = box.dynamicBound().front();
+ if (auto low = spec->lbound().GetExplicit()) {
+ auto expr = Fortran::lower::SomeExpr{*low};
+ mlir::Value lb = builder.createConvert(
+ loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
+ result.append(box.dynamicBound().size(), lb);
+ }
+ return;
+ }
for (const Fortran::semantics::ShapeSpec *spec : box.dynamicBound()) {
if (auto low = spec->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
@@ -2001,11 +2029,24 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
// extracted upper bound for every dimension's extent computation.
llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
converter, loc, box, /*upper=*/true, idxTy, symMap, stmtCtx);
+ // A non-ROBE upper bound in a rank-1-bound-expanded array is a single scalar
+ // broadcast across every dimension; evaluate it once and reuse it.
+ mlir::Value broadcastUpper;
+ if (sharedUpper.empty() && hasRankOneBoundElement(box)) {
+ const Fortran::semantics::ShapeSpec *spec = box.dynamicBound().front();
+ if (auto up = spec->ubound().GetExplicit()) {
+ auto expr = Fortran::lower::SomeExpr{*up};
+ broadcastUpper = builder.createConvert(
+ loc, idxTy, genScalarValue(converter, loc, expr, symMap, stmtCtx));
+ }
+ }
for (const auto &spec : llvm::enumerate(box.dynamicBound())) {
if (auto up = spec.value()->ubound().GetExplicit()) {
mlir::Value ub;
if (!sharedUpper.empty()) {
ub = sharedUpper[spec.index()];
+ } else if (broadcastUpper) {
+ ub = broadcastUpper;
} else {
auto expr = Fortran::lower::SomeExpr{*up};
ub = builder.createConvert(
@@ -2023,27 +2064,19 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
assert(result.empty() || result.size() == box.dynamicBound().size());
}
-llvm::SmallVector<mlir::Value> Fortran::lower::lowerExplicitResultExtents(
+llvm::SmallVector<mlir::Value> Fortran::lower::lowerExplicitMappedExtents(
Fortran::lower::AbstractConverter &converter, mlir::Location loc,
- const Fortran::semantics::Symbol &result, Fortran::lower::SymMap &symMap,
+ const Fortran::semantics::Symbol &symbol, Fortran::lower::SymMap &symMap,
Fortran::lower::StatementContext &stmtCtx) {
Fortran::lower::BoxAnalyzer box;
- box.analyze(result);
+ box.analyze(symbol);
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)
+ if (!hasRankOneBoundElement(box))
return extents;
llvm::SmallVector<mlir::Value> lowerBounds;
lowerExplicitLowerBounds(converter, loc, box, lowerBounds, symMap, stmtCtx);
@@ -2662,6 +2695,22 @@ void Fortran::lower::mapSymbolAttributes(
converter, loc, ba, /*upper=*/false, idxTy, symMap, stmtCtx);
llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
converter, loc, ba, /*upper=*/true, idxTy, symMap, stmtCtx);
+ // A non-ROBE bound in a rank-1-bound-expanded array is a single scalar
+ // broadcast across every dimension; evaluate it once and reuse it.
+ mlir::Value broadcastLower, broadcastUpper;
+ if (hasRankOneBoundElement(ba)) {
+ const Fortran::semantics::ShapeSpec *spec0 = ba.dynamicBound().front();
+ if (sharedLower.empty())
+ if (auto low = spec0->lbound().GetExplicit()) {
+ auto expr = Fortran::lower::SomeExpr{*low};
+ broadcastLower = builder.createConvert(loc, idxTy, genValue(expr));
+ }
+ if (sharedUpper.empty())
+ if (auto high = spec0->ubound().GetExplicit()) {
+ auto expr = Fortran::lower::SomeExpr{*high};
+ broadcastUpper = builder.createConvert(loc, idxTy, genValue(expr));
+ }
+ }
for (auto iter : llvm::enumerate(bounds)) {
auto *spec = iter.value();
fir::BoxDimsOp dimInfo;
@@ -2686,6 +2735,8 @@ void Fortran::lower::mapSymbolAttributes(
} else {
if (!sharedLower.empty()) {
lb = sharedLower[iter.index()];
+ } else if (broadcastLower) {
+ lb = broadcastLower;
} else if (auto low = spec->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
lb = builder.createConvert(loc, idxTy, genValue(expr));
@@ -2698,6 +2749,10 @@ void Fortran::lower::mapSymbolAttributes(
ub = sharedUpper[iter.index()];
extents.emplace_back(
fir::factory::computeExtent(builder, loc, lb, ub));
+ } else if (broadcastUpper) {
+ ub = broadcastUpper;
+ 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));
diff --git a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90 b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
index b5ce4cc111985..003435cd9a34c 100644
--- a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
+++ b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
@@ -3,7 +3,7 @@
! 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
+! RUN: bbc -emit-hlfir -o - %s -I nowhere | FileCheck %s
! 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
@@ -209,3 +209,58 @@ subroutine test_result_robe_caller(n, y)
! CHECK: fir.shape %{{.*}}, %{{.*}}, %{{.*}} : (index, index, index) -> !fir.shape<3>
! CHECK: fir.call @_QMtest_result_robePf(
+! Caller side: sequence-associating an actual with a polymorphic explicit-shape
+! dummy x(mb(k)) remaps the actual into the dummy's shape. The shared base
+! mb(k) is evaluated once for all dummy dimensions rather than re-evaluated per
+! dimension, matching the result-extent path.
+module test_remap_robe
+ type :: t
+ integer :: i
+ end type
+contains
+ pure function mb(k) result(r)
+ integer, intent(in) :: k
+ integer :: r(3)
+ r = [k, k + 1, k + 2]
+ end function
+ subroutine callee(k, x)
+ integer, intent(in) :: k
+ class(t), intent(in) :: x(mb(k))
+ end subroutine
+ subroutine test_remap_robe_caller(k, y)
+ integer, intent(in) :: k
+ class(t) :: y(:, :, :)
+ call callee(k, y)
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_remap_robePtest_remap_robe_caller(
+! CHECK: hlfir.eval_in_mem shape %{{.*}} -> !hlfir.expr<3xi32> {
+! CHECK: fir.call @_QMtest_remap_robePmb(
+! CHECK: }
+! CHECK-NOT: fir.call @_QMtest_remap_robePmb(
+! CHECK: fir.shape %{{.*}}, %{{.*}}, %{{.*}} : (index, index, index) -> !fir.shape<3>
+! CHECK: fir.embox
+! CHECK: fir.call @_QMtest_remap_robePcallee(
+
+! A broadcast scalar bound in a rank-1-bound-expanded array: a(lb(n(1)):n) has a
+! scalar lower bound lb(n(1)) cloned across every dimension produced by the
+! rank-1 upper bound n. That scalar is evaluated once and reused for every
+! dimension rather than re-evaluated per dimension.
+module test_broadcast_scalar
+contains
+ pure integer function lb(k)
+ integer, intent(in) :: k
+ lb = k
+ end function
+ subroutine test_broadcast_scalar_bounds(n)
+ integer, intent(in) :: n(3)
+ real :: a(lb(n(1)):n)
+ a = 0.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_broadcast_scalarPtest_broadcast_scalar_bounds(
+! CHECK: fir.call @_QMtest_broadcast_scalarPlb(
+! CHECK-NOT: fir.call @_QMtest_broadcast_scalarPlb(
+! CHECK: fir.shape_shift %{{.*}} -> !fir.shapeshift<3>
+! CHECK: hlfir.declare {{.*}}Ea"
+
>From afd5448eb9693385823222ebbbdeef3ed3b0940f Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 13 Oct 2026 19:56:59 -0500
Subject: [PATCH 8/8] Address review: drop ROBE builtin, fix lowering reuse,
stop %ROBE leaking into mod files
Remove the __builtin_rank1_bound_element read-back path. It was never emitted
to mod files, so the recognition code in expression.cpp / intrinsics.cpp /
resolve-names.cpp was dead and only served as an attack surface from user
source (CHECK crash on bad dim, hijacked user procedures, and a user type of
the same name mis-read from a module).
Serialize a surviving RankOneBoundElement by provenance instead. A rank-1
bound element that cannot be reduced to a scalar (e.g. an elemental merge()
with a LOGICAL mask) now carries the originating array and bound side and is
written as a real ubound(a,dim)/lbound(a,dim) call, so the mod file holds
ordinary Fortran and re-analysis on USE inherits the normal DIM-range checks.
Stamp that provenance where a bound is copied out of its ShapeSpec in
shape.cpp, and only where the intrinsic is exact: ubound() when the lower
bound is 1, lbound() when the dimension is provably nonempty. This closes a
leak where shape(a), size(a) with no DIM, and sizeof(a) folded over an
irreducible base and wrote the %ROBE debug marker into the mod file (fatal
on USE). Inquiries whose extent would still embed a raw element (e.g. a
constant lower bound other than 1) keep themselves unfolded rather than
serialize a bound that is wrong for an empty dimension. A structural CHECK
in the mod-file writer's PutBound guards against any future path that
copies a bound without going through this.
Lowering: lowerSharedRankOneBounds now verifies every element on a side has
the same base before reusing the first, and the front() broadcast of a
scalar bound is gated on all bounds on that side being identical; both fall
back to per-bound lowering otherwise.
Tests: round-trip cases for shape/size/sizeof over irreducible bases (both
the folding and the declining forms), a separate-compilation provider/
consumer test, a checked-in corrupted mod file exercising DIM-range
diagnostics on read-back, DIM validation cases, and lowering coverage for
mixed-base and mixed-side bounds.
---
flang/include/flang/Evaluate/intrinsics.h | 8 -
flang/include/flang/Evaluate/shape.h | 6 +
flang/include/flang/Evaluate/variable.h | 19 ++
flang/include/flang/Semantics/expression.h | 1 -
flang/lib/Evaluate/fold-integer.cpp | 42 ++-
flang/lib/Evaluate/formatting.cpp | 21 +-
flang/lib/Evaluate/intrinsics.cpp | 1 -
flang/lib/Evaluate/shape.cpp | 64 +++-
flang/lib/Lower/ConvertVariable.cpp | 53 ++-
flang/lib/Semantics/expression.cpp | 35 --
flang/lib/Semantics/mod-file.cpp | 5 +
.../Lower/HLFIR/explicit-shape-bounds.f90 | 49 +++
flang/test/Semantics/Inputs/mbaddim.mod | 12 +
.../declaration-explicit-array-bounds.f90 | 12 +
.../modfile-explicit-shape-bounds.f90 | 310 +++++++++++++++++-
.../Semantics/modfile-rank1-bound-baddim.f90 | 33 ++
.../Semantics/modfile-rank1-bound-element.f90 | 26 +-
.../Semantics/rank1-bound-element-symbols.f90 | 2 +-
18 files changed, 598 insertions(+), 101 deletions(-)
create mode 100644 flang/test/Semantics/Inputs/mbaddim.mod
create mode 100644 flang/test/Semantics/modfile-rank1-bound-baddim.f90
diff --git a/flang/include/flang/Evaluate/intrinsics.h b/flang/include/flang/Evaluate/intrinsics.h
index 1ba333cda98f3..1757dc2ed2467 100644
--- a/flang/include/flang/Evaluate/intrinsics.h
+++ b/flang/include/flang/Evaluate/intrinsics.h
@@ -118,14 +118,6 @@ 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/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index e82401dcfebd8..115cb47e194af 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -150,6 +150,12 @@ inline MaybeExtentExpr GetSize(const std::optional<Shape> &maybeShape) {
// Utility predicate: does an expression reference any implied DO index?
bool ContainsAnyImpliedDoIndex(const ExtentExpr &);
+// Utility predicate: does an expression embed a RankOneBoundElement that has
+// no ubound()/lbound() provenance? Such an element has no Fortran spelling
+// (its debug rendering is the synthetic %ROBE marker) and must never reach a
+// mod file; an inquiry whose folded result would contain one must stay intact.
+bool ContainsUntaggedRankOneBoundElement(const ExtentExpr &);
+
// GetShape()
class GetShapeHelper
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index f510873ec2fe2..314472b5ed8c7 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -453,6 +453,23 @@ class RankOneBoundElement {
Expr<SubscriptInteger> &base() { return base_.value(); }
int dimension() const { return dimension_; }
+ // Optional provenance. When this element was produced by folding an
+ // UBOUND()/LBOUND() inquiry of an explicit-shape array whose shape came from
+ // a rank-1 array bound, record the originating array and bound side so the
+ // mod-file writer can serialize it as the real ubound(a,dim)/lbound(a,dim)
+ // intrinsic instead of the synthetic %ROBE spelling.
+ // Declaration-time elements carry no provenance. Provenance is metadata for
+ // serialization only: it is excluded from operator== and hashing so that the
+ // builtin reuse/deduplication optimizations are unaffected.
+ const std::optional<NamedEntity> &originatingArray() const {
+ return originatingArray_;
+ }
+ bool isUpperBound() const { return isUpperBound_; }
+ void set_provenance(const NamedEntity &array, bool isUpper) {
+ originatingArray_ = array;
+ isUpperBound_ = isUpper;
+ }
+
static constexpr int Rank() { return 0; } // always scalar
static constexpr int Corank() { return 0; }
bool operator==(const RankOneBoundElement &) const;
@@ -461,6 +478,8 @@ class RankOneBoundElement {
private:
common::CopyableIndirection<Expr<SubscriptInteger>> base_;
int dimension_{0}; // zero-based
+ std::optional<NamedEntity> originatingArray_;
+ bool isUpperBound_{false};
};
#define INSTANTIATE_VARIABLE_TEMPLATES \
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index c84a80b0682d8..59cd424c4dae9 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -397,7 +397,6 @@ 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 028e28e2ba52a..42e1efaaa6126 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -173,6 +173,22 @@ class GetConstantArrayBoundHelper {
bool arrayFromParenthesesExpr{false};
};
+// Gate for folding SHAPE/SIZE/SIZEOF into a stored expression: a raw rank-1
+// bound element left in an extent (because neither UBOUND nor LBOUND is exact
+// for that dimension; see CloneBound in shape.cpp) has no Fortran spelling, so
+// the inquiry must stay intact rather than fold.
+static bool ShapeHasUntaggedRankOneBoundElement(
+ const std::optional<Shape> &shape) {
+ if (shape) {
+ for (const auto &extent : *shape) {
+ if (extent && ContainsUntaggedRankOneBoundElement(*extent)) {
+ return true;
+ }
+ }
+ }
+ return false;
+}
+
template <int KIND>
Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
FunctionRef<Type<TypeCategory::Integer, KIND>> &&funcRef) {
@@ -1410,7 +1426,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
}
} else if (name == "shape") {
- if (auto shape{GetContextFreeShape(context, args[0])}) {
+ if (auto shape{GetContextFreeShape(context, args[0])};
+ shape && !ShapeHasUntaggedRankOneBoundElement(shape)) {
if (auto shapeExpr{AsExtentArrayExpr(*shape)}) {
return Fold(context, ConvertToType<T>(std::move(*shapeExpr)));
}
@@ -1427,7 +1444,8 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
return result.value;
}));
} else if (name == "size") {
- if (auto shape{GetContextFreeShape(context, args[0])}) {
+ if (auto shape{GetContextFreeShape(context, args[0])};
+ shape && !ShapeHasUntaggedRankOneBoundElement(shape)) {
if (args[1]) { // DIM= is present, get one extent
std::optional<int> dim;
if (const auto *array{args[0].value().UnwrapExpr()}; array &&
@@ -1448,10 +1466,13 @@ Expr<Type<TypeCategory::Integer, KIND>> FoldIntrinsicFunction(
}
}
} else if (name == "sizeof") { // in bytes; extension
- if (auto info{
- characteristics::TypeAndShape::Characterize(args[0], context)}) {
- if (auto bytes{info->MeasureSizeInBytes(context)}) {
- return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
+ if (!ShapeHasUntaggedRankOneBoundElement(
+ GetContextFreeShape(context, args[0]))) {
+ if (auto info{
+ characteristics::TypeAndShape::Characterize(args[0], context)}) {
+ if (auto bytes{info->MeasureSizeInBytes(context)}) {
+ return Expr<T>{Fold(context, ConvertToType<T>(std::move(*bytes)))};
+ }
}
}
} else if (name == "storage_size") { // in bits
@@ -1884,8 +1905,13 @@ Expr<RankOneBoundElement::Result> FoldOperation(
if (auto reduced{ExtractRankOneElement(context, folded, x.dimension())}) {
return Fold(context, std::move(*reduced));
}
- return Expr<ResultType>{
- RankOneBoundElement{std::move(folded), x.dimension()}};
+ RankOneBoundElement result{std::move(folded), x.dimension()};
+ // Preserve any serialization provenance (ubound/lbound origin) so an
+ // irreducible element still round-trips as a real intrinsic in a mod file.
+ if (x.originatingArray()) {
+ result.set_provenance(*x.originatingArray(), x.isUpperBound());
+ }
+ return Expr<ResultType>{std::move(result)};
}
std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 4e46102d01d3e..ae57128d822e1 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -895,12 +895,21 @@ 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 as a recognized builtin so a mod file can
- // round-trip it (see IntrinsicProcTable::BuiltinRank1BoundElementName).
- base().AsFortran(o << IntrinsicProcTable::BuiltinRank1BoundElementName << "(")
- << ",dim=" << (dimension_ + 1) << ')';
+ if (originatingArray_) {
+ // This element was produced by folding an UBOUND()/LBOUND() inquiry of an
+ // explicit-shape array declared with a rank-1 array bound. Serialize it as
+ // the originating intrinsic so the mod file round-trips as real Fortran.
+ o << (isUpperBound_ ? "ubound(" : "lbound(");
+ originatingArray_->AsFortran(o);
+ return o << ",dim=" << (dimension_ + 1) << ",kind=" << Result::kind << ')';
+ }
+ // A declaration-time RankOneBoundElement extracts a single element from a
+ // rank-1 array expression used as an array bound. It has no true Fortran
+ // surface syntax and never reaches a mod file (the writer unwraps the whole
+ // base instead), so it only appears in developer dumps such as
+ // -fdebug-dump-symbols. Render it with a synthetic %ROBE marker, mirroring
+ // the %STRIDE descriptor-inquiry spelling, to signal it is not real Fortran.
+ base().AsFortran(o << "%ROBE(") << ",dim=" << (dimension_ + 1) << ')';
return o;
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index e5ab84f0dae09..88874f7ef08e8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -2991,7 +2991,6 @@ bool IntrinsicProcTable::Implementation::IsIntrinsicFunction(
}
// special cases
return name == "__builtin_c_loc" || name == "__builtin_c_devloc" ||
- name == IntrinsicProcTable::BuiltinRank1BoundElementName ||
name == "null" || name == "next" || name == "previous";
}
bool IntrinsicProcTable::Implementation::IsIntrinsicSubroutine(
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index f0fba61a25bde..2eb19096f24bc 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -232,6 +232,37 @@ bool ContainsAnyImpliedDoIndex(const ExtentExpr &expr) {
return MyVisitor{}(expr);
}
+bool ContainsUntaggedRankOneBoundElement(const ExtentExpr &expr) {
+ struct MyVisitor : public AnyTraverse<MyVisitor> {
+ using Base = AnyTraverse<MyVisitor>;
+ MyVisitor() : Base{*this} {}
+ using Base::operator();
+ bool operator()(const RankOneBoundElement &x) {
+ return !x.originatingArray() || (*this)(x.base());
+ }
+ };
+ return MyVisitor{}(expr);
+}
+
+// Copies a declared bound out of its ShapeSpec. A rank-1 array bound is stored
+// as a RankOneBoundElement wrapping the whole rank-1 expression; the copy is
+// stamped with ubound()/lbound() provenance so that, if it survives folding, it
+// serializes as that intrinsic rather than as the non-Fortran %ROBE marker.
+// Callers must only request provenance where the intrinsic is exact, i.e. where
+// its empty-dimension result (UBOUND -> 0, LBOUND -> 1) coincides with the
+// declared bound; otherwise the raw copy stays untagged and any inquiry that
+// would embed it must decline to fold.
+static ExtentExpr CloneBound(const ExtentExpr &bound,
+ const NamedEntity *array = nullptr, bool isUpperBound = false) {
+ ExtentExpr copy{bound};
+ if (array) {
+ if (auto *robe{std::get_if<RankOneBoundElement>(©.u)}) {
+ robe->set_provenance(*array, isUpperBound);
+ }
+ }
+ return copy;
+}
+
// 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.
@@ -303,9 +334,12 @@ class GetLowerBoundHelper
}
}
}
- return ok ? *lbound : Result{};
+ // ok: LBOUND is exact here (lb==1, dimension provably nonempty,
+ // or assumed-size last dimension), so lbound() provenance is
+ // safe.
+ return ok ? Result{CloneBound(*lbound, &base, false)} : Result{};
} else {
- return *lbound;
+ return CloneBound(*lbound); // raw declared bound, internal use
}
} else {
return Result{1};
@@ -455,7 +489,7 @@ Shape GetLBOUNDs(
// If the upper and lower bounds are constant, return a constant expression for
// the extent. In particular, if the upper bound is less than the lower bound,
// return zero.
-static MaybeExtentExpr GetNonNegativeExtent(
+static MaybeExtentExpr GetNonNegativeExtent(const NamedEntity &base,
const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
const auto &ubound{shapeSpec.ubound().GetExplicit()};
const auto &lbound{shapeSpec.lbound().GetExplicit()};
@@ -481,12 +515,16 @@ static MaybeExtentExpr GetNonNegativeExtent(
// Apply effective IDIM (MAX calculation with 0) so thet the
// result is never negative
if (lval.value_or(0) == 1) {
- return ExtentExpr{Extremum<SubscriptInteger>{
- Ordering::Greater, ExtentExpr{0}, common::Clone(*ubound)}};
+ // max(0,ub) == max(0,UBOUND(a,dim)) for every ub when lb == 1, so a
+ // surviving rank-1 bound element can carry ubound() provenance exactly.
+ return ExtentExpr{Extremum<SubscriptInteger>{Ordering::Greater,
+ ExtentExpr{0}, CloneBound(*ubound, &base, /*isUpperBound=*/true)}};
} else {
+ // Neither UBOUND() nor LBOUND() equals the declared bound of an empty
+ // dimension, so the raw copies cannot carry provenance here.
return ExtentExpr{
Extremum<SubscriptInteger>{Ordering::Greater, ExtentExpr{0},
- common::Clone(*ubound) - common::Clone(*lbound) + ExtentExpr{1}}};
+ CloneBound(*ubound) - CloneBound(*lbound) + ExtentExpr{1}}};
}
} else {
return std::nullopt;
@@ -543,7 +581,8 @@ MaybeExtentExpr GetExtent(
int j{0};
for (const auto &shapeSpec : details->shape()) {
if (j++ == dimension) {
- if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
+ if (auto extent{
+ GetNonNegativeExtent(base, shapeSpec, invariantOnly)}) {
return extent;
} else if (semantics::IsAssumedSizeArray(symbol) &&
j == symbol.Rank()) {
@@ -657,15 +696,17 @@ MaybeExtentExpr GetRawUpperBound(FoldingContext &context,
}
static MaybeExtentExpr GetExplicitUBOUND(FoldingContext *context,
- const semantics::ShapeSpec &shapeSpec, bool invariantOnly) {
+ const NamedEntity &base, const semantics::ShapeSpec &shapeSpec,
+ bool invariantOnly) {
const auto &ubound{shapeSpec.ubound().GetExplicit()};
if (ubound && ubound->Rank() == 0 &&
(!invariantOnly || IsScopeInvariantExpr(*ubound, context))) {
- if (auto extent{GetNonNegativeExtent(shapeSpec, invariantOnly)}) {
+ if (auto extent{GetNonNegativeExtent(base, shapeSpec, invariantOnly)}) {
if (auto cstExtent{ToInt64(
context ? Fold(*context, std::move(*extent)) : *extent)}) {
if (cstExtent > 0) {
- return *ubound;
+ // Dimension is nonempty, so UBOUND is exactly the declared bound.
+ return CloneBound(*ubound, &base, /*isUpperBound=*/true);
} else if (cstExtent == 0) {
return ExtentExpr{0};
}
@@ -682,7 +723,8 @@ static MaybeExtentExpr GetUBOUND(FoldingContext *context,
int rank{details->shape().Rank()};
if (dimension < rank) {
const semantics::ShapeSpec &shapeSpec{details->shape()[dimension]};
- if (auto ubound{GetExplicitUBOUND(context, shapeSpec, invariantOnly)}) {
+ if (auto ubound{
+ GetExplicitUBOUND(context, base, shapeSpec, invariantOnly)}) {
return *ubound;
} else if (semantics::IsAssumedSizeArray(symbol) &&
dimension + 1 == symbol.Rank()) {
diff --git a/flang/lib/Lower/ConvertVariable.cpp b/flang/lib/Lower/ConvertVariable.cpp
index 627473cec45b3..5e184b8294115 100644
--- a/flang/lib/Lower/ConvertVariable.cpp
+++ b/flang/lib/Lower/ConvertVariable.cpp
@@ -1894,6 +1894,10 @@ static llvm::SmallVector<mlir::Value> lowerSharedRankOneBounds(
Fortran::evaluate::RankOneBoundElement>(*explicitBound)) {
if (!shared)
shared = robe;
+ else if (!(robe->base() == shared->base()))
+ // Different dimensions extract from different rank-1 bases, so they do
+ // not share a single base; let the caller lower each bound on its own.
+ return {};
} else {
return {};
}
@@ -1952,6 +1956,32 @@ static bool hasRankOneBoundElement(const Fortran::lower::BoxAnalyzer &box) {
return false;
}
+/// True when every dimension has an explicit bound on the requested side (lower
+/// or upper) and those bounds are all structurally identical. A rank-1 bound
+/// base expands to the whole declaration -- a comma list mixing it with other
+/// specs is rejected by semantics (see declaration-explicit-array-bounds.f90)
+/// -- so the front end clones the single user-written scalar bound on the
+/// non-ROBE side (e.g. the lower bound in `a(lb : rank1base)`) into every
+/// dimension's ShapeSpec, making them identical by construction. This is a
+/// defensive guard: if the bounds were ever not identical, the caller falls
+/// back to lowering each dimension on its own.
+static bool allSideBoundsIdentical(const Fortran::lower::BoxAnalyzer &box,
+ bool upper) {
+ const Fortran::semantics::SubscriptIntExpr *first = 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 false;
+ if (!first)
+ first = &*explicitBound;
+ else if (!(*explicitBound == *first))
+ return false;
+ }
+ return first != nullptr;
+}
+
/// 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(
@@ -1975,8 +2005,11 @@ static void lowerExplicitLowerBounds(
return;
}
// A non-ROBE lower bound in a rank-1-bound-expanded array is a single scalar
- // broadcast across every dimension; evaluate it once and reuse it.
- if (hasRankOneBoundElement(box)) {
+ // the front end cloned across every dimension; evaluate it once and reuse it.
+ // allSideBoundsIdentical is a defensive guard (the clones are identical by
+ // construction); if it ever fails, fall through to per-dimension lowering.
+ if (hasRankOneBoundElement(box) &&
+ allSideBoundsIdentical(box, /*upper=*/false)) {
const Fortran::semantics::ShapeSpec *spec = box.dynamicBound().front();
if (auto low = spec->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
@@ -2030,9 +2063,12 @@ lowerExplicitExtents(Fortran::lower::AbstractConverter &converter,
llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
converter, loc, box, /*upper=*/true, idxTy, symMap, stmtCtx);
// A non-ROBE upper bound in a rank-1-bound-expanded array is a single scalar
- // broadcast across every dimension; evaluate it once and reuse it.
+ // the front end cloned across every dimension; evaluate it once and reuse it.
+ // allSideBoundsIdentical is a defensive guard (the clones are identical by
+ // construction); if it ever fails, fall through to per-dimension lowering.
mlir::Value broadcastUpper;
- if (sharedUpper.empty() && hasRankOneBoundElement(box)) {
+ if (sharedUpper.empty() && hasRankOneBoundElement(box) &&
+ allSideBoundsIdentical(box, /*upper=*/true)) {
const Fortran::semantics::ShapeSpec *spec = box.dynamicBound().front();
if (auto up = spec->ubound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*up};
@@ -2696,16 +2732,19 @@ void Fortran::lower::mapSymbolAttributes(
llvm::SmallVector<mlir::Value> sharedUpper = lowerSharedRankOneBounds(
converter, loc, ba, /*upper=*/true, idxTy, symMap, stmtCtx);
// A non-ROBE bound in a rank-1-bound-expanded array is a single scalar
- // broadcast across every dimension; evaluate it once and reuse it.
+ // broadcast across every dimension; evaluate it once and reuse it. Only
+ // broadcast a side whose bounds are all the same cloned expression; a mixed
+ // array with distinct per-dimension bounds is lowered dimension by
+ // dimension below.
mlir::Value broadcastLower, broadcastUpper;
if (hasRankOneBoundElement(ba)) {
const Fortran::semantics::ShapeSpec *spec0 = ba.dynamicBound().front();
- if (sharedLower.empty())
+ if (sharedLower.empty() && allSideBoundsIdentical(ba, /*upper=*/false))
if (auto low = spec0->lbound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*low};
broadcastLower = builder.createConvert(loc, idxTy, genValue(expr));
}
- if (sharedUpper.empty())
+ if (sharedUpper.empty() && allSideBoundsIdentical(ba, /*upper=*/true))
if (auto high = spec0->ubound().GetExplicit()) {
auto expr = Fortran::lower::SomeExpr{*high};
broadcastUpper = builder.createConvert(loc, idxTy, genValue(expr));
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e3a4c0427908e..800b3cc808235 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -3806,18 +3806,6 @@ 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(),
@@ -5024,29 +5012,6 @@ 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/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index e17bfb2ee3f32..9dd316bf7eae2 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -11,6 +11,7 @@
#include "resolve-names.h"
#include "flang/Common/restorer.h"
#include "flang/Evaluate/fold.h"
+#include "flang/Evaluate/shape.h"
#include "flang/Evaluate/tools.h"
#include "flang/Parser/message.h"
#include "flang/Parser/parsing.h"
@@ -1405,6 +1406,10 @@ void PutBound(llvm::raw_ostream &os, const Bound &x) {
} else if (x.isColon()) {
os << ':';
} else {
+ // A raw ROBE has no Fortran spelling; it may only live in
+ // its own array's ShapeSpec, which PutShape() unwraps whole and never
+ // routes here. Anything else must carry ubound()/lbound() provenance.
+ CHECK(!evaluate::ContainsUntaggedRankOneBoundElement(*x.GetExplicit()));
x.GetExplicit()->AsFortran(os);
}
}
diff --git a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90 b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
index 003435cd9a34c..f338333dfa69f 100644
--- a/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
+++ b/flang/test/Lower/HLFIR/explicit-shape-bounds.f90
@@ -264,3 +264,52 @@ subroutine test_broadcast_scalar_bounds(n)
! CHECK: fir.shape_shift %{{.*}} -> !fir.shapeshift<3>
! CHECK: hlfir.declare {{.*}}Ea"
+! Two rank-1 bound elements with DIFFERENT bases on the same side: out's dim1
+! upper is ubound(b,2) (base m) and dim2 upper is ubound(d,2) (base p). The
+! shared-base reuse must not collapse both dimensions onto the first base; each
+! dimension extracts its element from its own base.
+module test_mixed_base
+contains
+ subroutine test_mixed_base_bounds(m, p, out)
+ integer, intent(in) :: m(2), p(2)
+ real :: b(m)
+ real :: d(p)
+ real :: out(ubound(b,2), ubound(d,2))
+ out = 0.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_mixed_basePtest_mixed_base_bounds(
+! CHECK: %[[M:.*]]:2 = hlfir.declare %arg0{{.*}}Em"
+! CHECK: %[[P:.*]]:2 = hlfir.declare %arg1{{.*}}Ep"
+! CHECK: hlfir.declare {{.*}}Eb"
+! CHECK: hlfir.declare {{.*}}Ed"
+! CHECK: hlfir.designate %[[M]]#0 ({{.*}}) : ({{.*}}) -> !fir.ref<i32>
+! CHECK: hlfir.designate %[[P]]#0 ({{.*}}) : ({{.*}}) -> !fir.ref<i32>
+! CHECK: %[[SHAPE:.*]] = fir.shape %{{.*}}, %{{.*}} : (index, index) -> !fir.shape<2>
+! CHECK: hlfir.declare %arg2(%[[SHAPE]]){{.*}}Eout"
+
+! A rank-1-bound-expanded array (b, declared with the rank-1 bound m) used only
+! as the argument of an ordinary descriptor inquiry. ubound(b,2) folds to a
+! runtime extent query, not a RankOneBoundElement, so out itself is NOT
+! rank-1-bound-expanded: hasRankOneBoundElement(out) is false and each of out's
+! dimensions is lowered independently (dim1 loads the scalar n; dim2 designates
+! m to evaluate ubound(b,2)). This guards against regressing that distinction --
+! an inquiry on a ROBE-expanded array must not itself be treated as a ROBE bound.
+module test_mixed_side
+contains
+ subroutine test_mixed_side_bounds(m, n, out)
+ integer, intent(in) :: m(2), n
+ real :: b(m)
+ real :: out(n, ubound(b,2))
+ out = 0.0
+ end subroutine
+end module
+! CHECK-LABEL: func.func @_QMtest_mixed_sidePtest_mixed_side_bounds(
+! CHECK: %[[M:.*]]:2 = hlfir.declare %arg0{{.*}}Em"
+! CHECK: %[[N:.*]]:2 = hlfir.declare %arg1{{.*}}En"
+! CHECK: hlfir.declare {{.*}}Eb"
+! CHECK: fir.load %[[N]]#0 : !fir.ref<i32>
+! CHECK: hlfir.designate %[[M]]#0 ({{.*}}) : ({{.*}}) -> !fir.ref<i32>
+! CHECK: %[[SHAPE:.*]] = fir.shape %{{.*}}, %{{.*}} : (index, index) -> !fir.shape<2>
+! CHECK: hlfir.declare %arg2(%[[SHAPE]]){{.*}}Eout"
+
diff --git a/flang/test/Semantics/Inputs/mbaddim.mod b/flang/test/Semantics/Inputs/mbaddim.mod
new file mode 100644
index 0000000000000..91dfd70740e6a
--- /dev/null
+++ b/flang/test/Semantics/Inputs/mbaddim.mod
@@ -0,0 +1,12 @@
+!mod$ v1 sum:0df54fe14f12f633
+module mbaddim
+contains
+subroutine s(n,m,c,a,b,d)
+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,ubound(a,dim=9,kind=8)),kind=4),kind=8))
+real(4)::d(1_8:__builtin_int(__builtin_int(max(0_8,ubound(a,dim=2147483648_8,kind=8)),kind=4),kind=8))
+end
+end
diff --git a/flang/test/Semantics/declaration-explicit-array-bounds.f90 b/flang/test/Semantics/declaration-explicit-array-bounds.f90
index 0b3d43ba0a4fd..421b74fdd6650 100644
--- a/flang/test/Semantics/declaration-explicit-array-bounds.f90
+++ b/flang/test/Semantics/declaration-explicit-array-bounds.f90
@@ -283,4 +283,16 @@ program declaration_array_bounds
!ERROR: DECLARATION rank-1 integer array bound(s) imply rank 2147483648, which is greater than the maximum supported rank 15
integer :: too_big(n)
+ ! A rank-1 bound base gives the array its rank; an intrinsic inquiry on that
+ ! array (ubound/lbound/size) -- the form such a bound takes when serialized to
+ ! a module file -- is validated by the ordinary DIM-range check. A DIM beyond
+ ! the rank, including one that overflows signed 32-bit (2^31), is rejected
+ ! without wrapping, so a consumer cannot be handed an out-of-range dimension.
+ integer, parameter :: twodims(2) = [3, 4]
+ integer :: a_dim(twodims) ! rank-2
+ !ERROR: DIM=9 dimension is out of range for rank-2 array
+ integer :: bad_dim(ubound(a_dim, 9))
+ !ERROR: DIM=2147483648 dimension is out of range for rank-2 array
+ integer :: bad_dim_ovf(ubound(a_dim, 2147483648_8))
+
end program
diff --git a/flang/test/Semantics/modfile-explicit-shape-bounds.f90 b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
index 1ee49d9e4e74d..b58587201a338 100644
--- a/flang/test/Semantics/modfile-explicit-shape-bounds.f90
+++ b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
@@ -71,7 +71,7 @@ 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
+ real, intent(inout) :: a_bothfold(lbs_fold : ubs_fold) ! both const parameters lbs_fold and ubs_fold
end subroutine
end module
@@ -121,12 +121,12 @@ subroutine s(n, a, b)
! 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.
+! `%ROBE(...)` spelling.
!===============================================================================
!-------------------------------------------------------------------------------
! Reducible bases: the single ROBE collapses to a plain scalar element ref
-! (no __builtin_rank1_bound_element in the mod file).
+! (no %ROBE in the mod file).
!-------------------------------------------------------------------------------
! Whole array COMPONENT base -> reduces to x%c(2_8)
@@ -496,12 +496,13 @@ subroutine s(n, a, b)
!-------------------------------------------------------------------------------
! 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.
+! helper can't distribute element extraction into the base, so the element
+! survives folding. When the elemet came from an UBOUND()/LBOUND() inquiry of
+! another explicit-shape array (here `ubound(a,2)`), it carries provenance and
+! is serialized as that real intrinsic -- `ubound(a,dim=2,kind=8)` -- which
+! round-trips without the synthetic spelling.
+! 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
@@ -525,7 +526,67 @@ subroutine s(n, m, c, a, b)
!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))
+!real(4)::b(1_8:__builtin_int(__builtin_int(max(0_8,ubound(a,dim=2,kind=8)),kind=4),kind=8))
+!end
+!end
+
+! SIZE(a,dim) on a dimension with the default lower bound of 1 folds to the same
+! provenance ROBE as UBOUND(a,dim) (size == ubound when the lower bound is 1), so
+! it serializes as max(0,ubound(a,dim)...) and lowers to the shared bound
+! arithmetic rather than a runtime SIZE inquiry -- never the synthetic %ROBE
+! spelling.
+module msizeprovenance
+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(size(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: msizeprovenance.mod
+!module msizeprovenance
+!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,ubound(a,dim=2,kind=8)),kind=4),kind=8))
+!end
+!end
+
+! SIZE(a,dim) on a dimension with a NON-constant lower bound cannot fold safely:
+! the extent max(0,ub-lb+1) would mix a raw upper bound with an intrinsic
+! lbound(a,dim), which fails to round-trip for an empty dimension (LBOUND is 1
+! for an empty dimension). GetLBOUND bails for such a bound, so SIZE keeps the
+! inquiry intact and serializes as size(a,dim) -- mirroring UBOUND(), which also
+! declines here.
+module msizenonconstlower
+contains
+ subroutine s(lo, m, c, hi, a, b)
+ integer, intent(in) :: lo(2), m(2), hi(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(lo, m, c) : hi)
+ real :: b(size(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: msizenonconstlower.mod
+!module msizenonconstlower
+!contains
+!subroutine s(lo,m,c,hi,a,b)
+!integer(4),intent(in)::lo(1_8:2_8)
+!integer(4),intent(in)::m(1_8:2_8)
+!logical(4),intent(in)::c(1_8:2_8)
+!integer(4),intent(in)::hi(1_8:2_8)
+!real(4)::a(__builtin_int(merge(lo,m,c),kind=8):__builtin_int(hi,kind=8))
+!real(4)::b(1_8:__builtin_int(size(a,2_4),kind=8))
!end
!end
@@ -539,7 +600,7 @@ subroutine s(n, m, c, a, b)
!-------------------------------------------------------------------------------
! User/specification FUNCTION base -> ubound degrades to size(a,dim=2), so no
-! ROBE is ever formed (no __builtin_rank1_bound_element).
+! ROBE is ever formed (no %ROBE).
module muserfunc
contains
pure function gb() result(r)
@@ -565,3 +626,230 @@ subroutine s(a, b)
!real(4)::b(1_8:size(a,dim=2,kind=8))
!end
!end
+
+!===============================================================================
+! LBOUND emission
+!
+! Unlike UBOUND, an LBOUND(a,dim) inquiry on a dimension whose declared lower
+! bound is a non-constant rank-1 bound expression does NOT fold to a provenance
+! ROBE. LBOUND is defined to return 1 for an empty dimension, so the folder
+! only replaces it with the declared lower bound when it can prove the dimension
+! is nonempty. It cannot prove that for a non-constant bound, so it leaves the
+! inquiry intact and serializes it as lbound(a,dim) -- mirroring the size(a,dim)
+! case, never the %ROBE spelling.
+!===============================================================================
+
+! Plain rank-1 array lower bound -> lbound(a,2) stays unfolded.
+module mlboundplain
+contains
+ subroutine s(lo, hi, a, b)
+ integer, intent(in) :: lo(2), hi(2)
+ real :: a(lo : hi)
+ real :: b(lbound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mlboundplain.mod
+!module mlboundplain
+!contains
+!subroutine s(lo,hi,a,b)
+!integer(4),intent(in)::lo(1_8:2_8)
+!integer(4),intent(in)::hi(1_8:2_8)
+!real(4)::a(__builtin_int(lo,kind=8):__builtin_int(hi,kind=8))
+!real(4)::b(1_8:__builtin_int(lbound(a,2_4),kind=8))
+!end
+!end
+
+! Surviving (merge) rank-1 lower base -> lbound(a,2) still stays unfolded.
+module mlboundmerge
+contains
+ subroutine s(lo, m, c, hi, a, b)
+ integer, intent(in) :: lo(2), m(2), hi(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(lo, m, c) : hi)
+ real :: b(lbound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+
+!Expect: mlboundmerge.mod
+!module mlboundmerge
+!contains
+!subroutine s(lo,m,c,hi,a,b)
+!integer(4),intent(in)::lo(1_8:2_8)
+!integer(4),intent(in)::m(1_8:2_8)
+!logical(4),intent(in)::c(1_8:2_8)
+!integer(4),intent(in)::hi(1_8:2_8)
+!real(4)::a(__builtin_int(merge(lo,m,c),kind=8):__builtin_int(hi,kind=8))
+!real(4)::b(1_8:__builtin_int(lbound(a,2_4),kind=8))
+!end
+!end
+
+!===============================================================================
+! Inquiry functions WITHOUT a DIM argument
+!
+! ubound(a)/lbound(a) with no DIM are themselves rank-1 integer arrays, so they
+! are F2023 explicit-shape bases in their own right: b and d become rank-2
+! arrays, one bounds-spec per element. These are declaration-time bounds (the
+! element carries no provenance), so the writer unwraps the whole rank-1 base
+! and serializes the folded array literal directly -- no ROBE is formed and no
+! %ROBE spelling can leak. size(a) with no DIM is a scalar, so e is an ordinary
+! rank-1 array with a plain scalar bound.
+!===============================================================================
+module mnodim
+contains
+ subroutine s(n, a, b, d, e)
+ integer, intent(in) :: n(2)
+ real :: a(n)
+ real :: b(ubound(a))
+ real :: d(lbound(a) : ubound(a))
+ real :: e(size(a))
+ b(1,1) = 1.0
+ a(1,1) = b(1,1)
+ end subroutine
+end module
+
+!Expect: mnodim.mod
+!module mnodim
+!contains
+!subroutine s(n,a,b,d,e)
+!integer(4),intent(in)::n(1_8:2_8)
+!real(4)::a(1_8:__builtin_int(n,kind=8))
+!real(4)::b(1_8:[INTEGER(8)::__builtin_int(__builtin_int(max(0_8,__builtin_int(n(1_8),kind=8)),kind=4),kind=8),__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8)])
+!real(4)::d([INTEGER(8)::1_8,1_8]:[INTEGER(8)::__builtin_int(__builtin_int(max(0_8,__builtin_int(n(1_8),kind=8)),kind=4),kind=8),__builtin_int(__builtin_int(max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8)])
+!real(4)::e(1_8:__builtin_int(__builtin_int(max(0_8,__builtin_int(n(1_8),kind=8))*max(0_8,__builtin_int(n(2_8),kind=8)),kind=4),kind=8))
+!end
+!end
+
+!===============================================================================
+! Extent-aggregating inquiries over an irreducible (merge) base
+!
+! shape(a), size(a) with no DIM, and sizeof(a) all expand every dimension to its
+! extent and aggregate them (a rank-1 vector, a product, and a byte count). When
+! the base cannot be reduced to a single element (here the merge() makes it
+! irreducible), the surviving upper-bound element has no Fortran surface syntax
+! and its only debug rendering is the %ROBE marker, which must never reach a mod
+! file. With the default lower bound of 1 the extent is max(0, ub), which equals
+! max(0, UBOUND(a,dim)) even for an empty dimension, so the element is stamped
+! with ubound(a,dim) provenance when it is copied out of a's shape and all three
+! inquiries -- plus size(a,2) with DIM -- serialize as real ubound() intrinsics
+! and round-trip. This is the regression guard for the aggregate-inquiry leak.
+!===============================================================================
+module maggregprovenance
+contains
+ subroutine s(n, m, c, a, bshape, bsizedim, bsize, bbytes)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(n, m, c))
+ real :: bshape(shape(a))
+ real :: bsizedim(size(a, 2))
+ real :: bsize(size(a))
+ real :: bbytes(sizeof(a))
+ bshape(1,1) = 1.0
+ bsizedim(1) = 1.0
+ bsize(1) = 1.0
+ bbytes(1) = 1.0
+ a(1,1) = bshape(1,1)
+ end subroutine
+end module
+
+!Expect: maggregprovenance.mod
+!module maggregprovenance
+!contains
+!subroutine s(n,m,c,a,bshape,bsizedim,bsize,bbytes)
+!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)::bshape(1_8:[INTEGER(8)::__builtin_int(__builtin_int(max(0_8,ubound(a,dim=1,kind=8)),kind=4),kind=8),__builtin_int(__builtin_int(max(0_8,ubound(a,dim=2,kind=8)),kind=4),kind=8)])
+!real(4)::bsizedim(1_8:__builtin_int(__builtin_int(max(0_8,ubound(a,dim=2,kind=8)),kind=4),kind=8))
+!real(4)::bsize(1_8:__builtin_int(__builtin_int(max(0_8,ubound(a,dim=1,kind=8))*max(0_8,ubound(a,dim=2,kind=8)),kind=4),kind=8))
+!real(4)::bbytes(1_8:4_8*max(0_8,ubound(a,dim=1,kind=8))*max(0_8,ubound(a,dim=2,kind=8)))
+!end
+!end
+
+!===============================================================================
+! Extent-aggregating inquiries over a non-constant (merge) LOWER bound
+!
+! Here the lower bound is itself an irreducible rank-1 element. The extent
+! max(0, ub - lb + 1) embeds it raw: LBOUND(a,dim) is 1, not the declared lower
+! bound, for an empty dimension, so lbound() provenance would be inexact and the
+! element has no Fortran spelling at all. Rather than emit the non-Fortran %ROBE
+! marker, shape(a)/size(a)/sizeof(a) keep themselves intact and serialize as the
+! real transformational inquiries, which round-trip as legal Fortran.
+!===============================================================================
+module maggregkeep
+contains
+ subroutine s(lo, m, c, hi, a, bshape, bsize, bbytes)
+ integer, intent(in) :: lo(2), m(2), hi(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(lo, m, c) : hi)
+ real :: bshape(shape(a))
+ real :: bsize(size(a))
+ real :: bbytes(sizeof(a))
+ bshape(1,1) = 1.0
+ bsize(1) = 1.0
+ bbytes(1) = 1.0
+ a(1,1) = bshape(1,1)
+ end subroutine
+end module
+
+!Expect: maggregkeep.mod
+!module maggregkeep
+!contains
+!subroutine s(lo,m,c,hi,a,bshape,bsize,bbytes)
+!integer(4),intent(in)::lo(1_8:2_8)
+!integer(4),intent(in)::m(1_8:2_8)
+!logical(4),intent(in)::c(1_8:2_8)
+!integer(4),intent(in)::hi(1_8:2_8)
+!real(4)::a(__builtin_int(merge(lo,m,c),kind=8):__builtin_int(hi,kind=8))
+!real(4)::bshape(1_8:__builtin_int(shape(a),kind=8))
+!real(4)::bsize(1_8:__builtin_int(size(a),kind=8))
+!real(4)::bbytes(1_8:sizeof(a))
+!end
+!end
+
+!===============================================================================
+! Extent-aggregating inquiries over a constant lower bound other than 1
+!
+! ubound(a,dim) provenance is exact only when the lower bound is 1: with a lower
+! bound of 0 the extent is max(0, ub + 1), but UBOUND(a,dim) of an empty
+! dimension is 0, so max(0, ubound(a,dim) + 1) would be 1 instead of 0. The
+! element is therefore left raw and every inquiry -- including size(a,2) with
+! DIM -- declines to fold rather than serialize a semantically wrong bound.
+!===============================================================================
+module maggregzerolower
+contains
+ subroutine s(n, m, c, a, bshape, bsizedim, bsize, bbytes)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(0 : merge(n, m, c))
+ real :: bshape(shape(a))
+ real :: bsizedim(size(a, 2))
+ real :: bsize(size(a))
+ real :: bbytes(sizeof(a))
+ bshape(1,1) = 1.0
+ bsizedim(1) = 1.0
+ bsize(1) = 1.0
+ bbytes(1) = 1.0
+ a(1,1) = bshape(1,1)
+ end subroutine
+end module
+
+!Expect: maggregzerolower.mod
+!module maggregzerolower
+!contains
+!subroutine s(n,m,c,a,bshape,bsizedim,bsize,bbytes)
+!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(0_8:__builtin_int(merge(n,m,c),kind=8))
+!real(4)::bshape(1_8:__builtin_int(shape(a),kind=8))
+!real(4)::bsizedim(1_8:__builtin_int(size(a,2_4),kind=8))
+!real(4)::bsize(1_8:__builtin_int(size(a),kind=8))
+!real(4)::bbytes(1_8:sizeof(a))
+!end
+!end
diff --git a/flang/test/Semantics/modfile-rank1-bound-baddim.f90 b/flang/test/Semantics/modfile-rank1-bound-baddim.f90
new file mode 100644
index 0000000000000..ec7fa9651945f
--- /dev/null
+++ b/flang/test/Semantics/modfile-rank1-bound-baddim.f90
@@ -0,0 +1,33 @@
+! RUN: not %flang_fc1 -fsyntax-only -J%S/Inputs %s 2>&1 | FileCheck %s
+
+! Inputs/mbaddim.mod was produced from the module below, then hand-edited to
+! corrupt the serialized rank-1-bound (ROBE) inquiries and recompute the
+! module-file checksum so it is read, not rejected as corrupt:
+! b: `ubound(a,dim=2,kind=8)` -> `ubound(a,dim=9,kind=8)`
+! d: `ubound(a,dim=2,kind=8)` -> `ubound(a,dim=2147483648_8,kind=8)` (2^31)
+! `a` has rank 2, so both DIMs are out of range (the 2^31 value also exercises
+! that a DIM past INT32_MAX is reported, not silently wrapped). Consuming the
+! module must re-analyze the serialized bound expressions and report the
+! out-of-range DIM gracefully rather than crash, proving a ROBE inquiry
+! round-tripped through a module file inherits the ordinary DIM-range check.
+
+#if 0
+module mbaddim
+contains
+ subroutine s(n, m, c, a, b, d)
+ integer, intent(in) :: n(2), m(2)
+ logical, intent(in) :: c(2)
+ real :: a(merge(n, m, c))
+ real :: b(ubound(a,2))
+ real :: d(ubound(a,2))
+ b(1) = 1.0
+ a(1,1) = b(1)
+ end subroutine
+end module
+#endif
+
+! CHECK-DAG: error: DIM=9 dimension is out of range for rank-2 array
+! CHECK-DAG: error: DIM=2147483648 dimension is out of range for rank-2 array
+program test
+ use mbaddim
+end program
diff --git a/flang/test/Semantics/modfile-rank1-bound-element.f90 b/flang/test/Semantics/modfile-rank1-bound-element.f90
index d596f4c5ecd2a..c6e2a7775f38d 100644
--- a/flang/test/Semantics/modfile-rank1-bound-element.f90
+++ b/flang/test/Semantics/modfile-rank1-bound-element.f90
@@ -1,12 +1,13 @@
-! 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.
+! Verify that an explicit-shape array bound which survives folding as a rank-1
+! bound element round-trips through a mod file read back by a *separate*
+! compilation. Such an element arises for a rank-1 array bound 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 Fortran surface syntax, so it is serialized through its UBOUND()/LBOUND()
+! provenance as a real ubound(a,dim)/lbound(a,dim) call: the mod file holds that
+! intrinsic, not the element, and reading it back simply re-analyzes an ordinary
+! ubound/lbound reference. The synthetic %ROBE debug marker must never appear
+! in the mod file.
!
! The provider and consumer are compiled separately so that the USE genuinely
! reads provider.mod from disk rather than reusing in-memory symbols.
@@ -19,11 +20,12 @@
!--- provider.f90
module m_rank1_bound_element_provider
contains
- subroutine s(n, m, c, a, b)
+ subroutine s(n, m, c, a, b, d)
integer, intent(in) :: n(2), m(2)
logical, intent(in) :: c(2)
- real :: a(merge(n, m, c))
- real :: b(ubound(a, 2))
+ real :: a(merge(n,m,c) : merge(n,m,c))
+ real :: b(lbound(a,1) : ubound(a,2))
+ real :: d(lbound(a,2) : size(a,2))
b(1) = 1.0
a(1, 1) = b(1)
end subroutine
diff --git a/flang/test/Semantics/rank1-bound-element-symbols.f90 b/flang/test/Semantics/rank1-bound-element-symbols.f90
index 2de10b99eb5a6..c788b3c9dcdc9 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:__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)
+ !SYMBOLS: a {{.*}}: ObjectEntity type: REAL(4) shape: 1_8:%ROBE(__builtin_int(n,kind=8),dim=1),1_8:%ROBE(__builtin_int(n,kind=8),dim=2),1_8:%ROBE(__builtin_int(n,kind=8),dim=3)
real :: a(n)
a = 0.0
end subroutine
More information about the flang-commits
mailing list