[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
Wed Sep 16 09:01:56 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/3] [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/3] 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/3] 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 {
More information about the flang-commits
mailing list