[flang-commits] [flang] [flang] Rank-1 integer array expressions in declarations and allocate statements (PR #183193)
via flang-commits
flang-commits at lists.llvm.org
Tue Mar 24 07:49:46 PDT 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/183193
>From fdf231e48ceb60f30caa1c85cc913358475f9ae1 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 10 Mar 2026 20:00:39 -0500
Subject: [PATCH 01/32] Implement rank-1 integer arrays used in declarations.
TODO: Implement and test unparse (minor), handle cases that do not need to be
const and AutomaticInMainProgram
---
flang/include/flang/Parser/dump-parse-tree.h | 1 +
flang/include/flang/Parser/parse-tree.h | 19 +-
flang/lib/Parser/unparse.cpp | 1 +
flang/lib/Semantics/resolve-names-utils.cpp | 221 +++++++++++++++++-
.../Semantics/declaration_array_bounds.f90 | 63 +++++
5 files changed, 299 insertions(+), 6 deletions(-)
create mode 100644 flang/test/Semantics/declaration_array_bounds.f90
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 84c7b8d2a5349..9f4a826fe3f6a 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -346,6 +346,7 @@ class ParseTreeDumper {
NODE(parser, ExitStmt)
NODE(parser, ExplicitCoshapeSpec)
NODE(parser, ExplicitShapeSpec)
+ NODE(parser, ExplicitShapeBoundsSpec)
NODE(parser, Expr)
NODE(Expr, Parentheses)
NODE(Expr, UnaryPlus)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 4aec99c80bdae..fe5100b1c9c4d 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1324,13 +1324,24 @@ WRAPPER_CLASS(ImpliedShapeSpec, std::list<AssumedImpliedSpec>);
EMPTY_CLASS(AssumedRankSpec);
// R815 array-spec ->
-// explicit-shape-spec-list | assumed-shape-spec-list |
-// deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
+// explicit-shape-spec-list | explicit-shape-bounds-spec |
+// assumed-shape-spec-list | deferred-shape-spec-list |
+// assumed-size-spec | implied-shape-spec |
// implied-shape-or-assumed-size-spec | assumed-rank-spec
+
+using ExplicitBoundsExpr = IntExpr;
+
+struct ExplicitShapeBoundsSpec {
+ TUPLE_CLASS_BOILERPLATE(ExplicitShapeBoundsSpec);
+ std::tuple<std::optional<ExplicitBoundsExpr>, ExplicitBoundsExpr>
+ t;
+};
+
struct ArraySpec {
UNION_CLASS_BOILERPLATE(ArraySpec);
- std::variant<std::list<ExplicitShapeSpec>, std::list<AssumedShapeSpec>,
- DeferredShapeSpecList, AssumedSizeSpec, ImpliedShapeSpec, AssumedRankSpec>
+ std::variant<std::list<ExplicitShapeSpec>, ExplicitShapeBoundsSpec,
+ std::list<AssumedShapeSpec>, DeferredShapeSpecList,
+ AssumedSizeSpec, ImpliedShapeSpec, AssumedRankSpec>
u;
};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 9d01bb74d70d3..ec25b0597f443 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -571,6 +571,7 @@ class UnparseVisitor {
common::visit(
common::visitors{
[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
+ [&](const ExplicitShapeBoundsSpec &y) { },
[&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
[&](const DeferredShapeSpecList &y) { Walk(y); },
[&](const AssumedSizeSpec &y) { Walk(y); },
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index ef34c89182f7f..9afc1489ea60d 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -203,6 +203,7 @@ class ArraySpecAnalyzer {
}
void Analyze(const parser::AssumedShapeSpec &);
void Analyze(const parser::ExplicitShapeSpec &);
+ void Analyze(const parser::ExplicitShapeBoundsSpec &);
void Analyze(const parser::AssumedImpliedSpec &);
void Analyze(const parser::DeferredShapeSpecList &);
void Analyze(const parser::AssumedRankSpec &);
@@ -212,6 +213,7 @@ class ArraySpecAnalyzer {
void MakeDeferred(int);
Bound GetBound(const std::optional<parser::SpecificationExpr> &);
Bound GetBound(const parser::SpecificationExpr &);
+ bool checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x);
};
ArraySpec AnalyzeArraySpec(
@@ -237,15 +239,79 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ComponentArraySpec &x) {
CHECK(!arraySpec_.empty());
return arraySpec_;
}
+
+static bool shouldRewriteShapeSpecListToExplicitBounds(
+ SemanticsContext &context, const parser::ArraySpec &x) {
+ auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
+ const_cast<parser::ArraySpec&>(x).u)};
+
+ if (explicitShapeSpecList.size() != 1) {
+ return false;
+ }
+
+ auto &explicitShapeSpec{explicitShapeSpecList.front()};
+ const auto &upperBound{std::get<1>(explicitShapeSpec.t)};
+ const auto &lowerBoundOpt{std::get<0>(explicitShapeSpec.t)};
+
+ bool foundArray{false};
+
+ if (MaybeExpr analyzedExpr = AnalyzeExpr(context, upperBound.v.thing.thing.value());
+ analyzedExpr && (analyzedExpr->Rank() > 0)) {
+ foundArray = true;
+ }
+
+ if (lowerBoundOpt) {
+ const auto &lowerBound{*lowerBoundOpt};
+ if (MaybeExpr analyzedExpr = AnalyzeExpr(context, lowerBound.v.thing.thing.value());
+ analyzedExpr && (analyzedExpr->Rank() > 0)) {
+ foundArray = true;
+ }
+ }
+
+ return foundArray;
+}
+
+static void rewriteShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
+ auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
+ const_cast<parser::ArraySpec&>(x).u)};
+ auto &mutableArraySpec{const_cast<parser::ArraySpec&>(x)};
+ auto &mutableExplicitShapeSpec{explicitShapeSpecList.front()};
+
+ auto &mutableUpperBound{std::get<1>(mutableExplicitShapeSpec.t)};
+ parser::IntExpr upperIntExpr{std::move(mutableUpperBound.v.thing)};
+
+ auto &lowerBoundOpt{std::get<0>(mutableExplicitShapeSpec.t)};
+ std::optional<parser::IntExpr> lowerIntExpr;
+ if (lowerBoundOpt) {
+ auto &mutableLowerBound{std::get<0>(mutableExplicitShapeSpec.t)};
+ if(mutableLowerBound) {
+ lowerIntExpr = std::move(mutableLowerBound->v.thing);
+ }
+ }
+
+ parser::ExplicitShapeBoundsSpec boundsSpec{
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ mutableArraySpec.u = std::move(boundsSpec);
+
+ return;
+}
+
ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
+ if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u) &&
+ shouldRewriteShapeSpecListToExplicitBounds(context_, x)) {
+ rewriteShapeSpecListToExplicitBounds(x);
+ }
common::visit(common::visitors{
[&](const parser::AssumedSizeSpec &y) {
Analyze(
std::get<std::list<parser::ExplicitShapeSpec>>(y.t));
Analyze(std::get<parser::AssumedImpliedSpec>(y.t));
},
- [&](const parser::ImpliedShapeSpec &y) { Analyze(y.v); },
- [&](const auto &y) { Analyze(y); },
+ [&](const parser::ImpliedShapeSpec &y) {
+ Analyze(y.v); },
+ [&](const auto &y) {
+ Analyze(y);
+ },
},
x.u);
CHECK(!arraySpec_.empty());
@@ -279,6 +345,157 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
MakeExplicit(std::get<std::optional<parser::SpecificationExpr>>(x.t),
std::get<parser::SpecificationExpr>(x.t));
}
+
+bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x) {
+ const auto &lowerBoundOpt{std::get<0>(x.t)};
+ const auto &upperBound{std::get<1>(x.t)};
+
+ MaybeExpr ubExpr{AnalyzeExpr(context_, upperBound.thing)};
+ auto ubFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubExpr))};
+ int ubRank{ubFolded.Rank()};
+
+ bool constError_{false};
+ bool rankError_{false};
+ if (!evaluate::IsActuallyConstant(ubFolded)) {
+ parser::CharBlock at{parser::FindSourceLocation(upperBound)};
+ context_.Say(at,
+ "Array (upper) bound must be a constant expression"_err_en_US);
+ constError_ = true;
+ }
+ if(ubRank > 1) {
+ parser::CharBlock at{parser::FindSourceLocation(upperBound)};
+ context_.Say(at,
+ "Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US, ubRank);
+ rankError_ = true;
+ }
+
+
+ int lbRank{0};
+ std::optional<SomeExpr> lbFolded;
+ if (lowerBoundOpt) {
+ MaybeExpr lbExpr{AnalyzeExpr(context_, lowerBoundOpt->thing)};
+ if (lbExpr) {
+ lbFolded = evaluate::Fold(context_.foldingContext(), std::move(*lbExpr));
+ lbRank = lbFolded->Rank();
+ if (!evaluate::IsActuallyConstant(*lbFolded)) {
+ parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
+ context_.Say(at,
+ "Array (lower) bound must be a constant expression"_err_en_US);
+ constError_ = true;
+ }
+ if(lbRank > 1) {
+ parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
+ context_.Say(at,
+ "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US, lbRank);
+ rankError_ = true;
+ }
+ }
+ }
+
+ if(constError_ || rankError_) return false;
+
+
+
+ // if both lower and upper bounds are arrays, they must have the same
+ // number of elements
+ if (lbRank == 1 && ubRank == 1) {
+ auto lbShape{evaluate::GetShape(context_.foldingContext(), *lbFolded)};
+ auto ubShape{evaluate::GetShape(context_.foldingContext(), ubFolded)};
+ if (lbShape && ubShape) {
+ auto lbSize{evaluate::GetSize(*lbShape)};
+ auto ubSize{evaluate::GetSize(*ubShape)};
+ if (lbSize && ubSize) {
+ auto lbSizeFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbSize))};
+ auto ubSizeFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubSize))};
+ auto lbSizeVal{evaluate::ToInt64(lbSizeFolded)};
+ auto ubSizeVal{evaluate::ToInt64(ubSizeFolded)};
+ if (lbSizeVal && ubSizeVal && *lbSizeVal != *ubSizeVal) {
+ parser::CharBlock at{parser::FindSourceLocation(x)};
+ context_.Say(at, "DECLARATION bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ static_cast<std::intmax_t>(*lbSizeVal),
+ static_cast<std::intmax_t>(*ubSizeVal));
+ return false;
+ }
+ }
+ }
+ }
+
+ return true;
+}
+
+
+
+
+
+void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
+ if(!checkExplicitShapeBoundsSpec(x)) {
+ // push a dummy bound arraySpec_ to satisfy CHECK(!arraySpec_.empty());
+ // in ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x).
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
+ }
+
+ const auto &lowerBoundOpt{std::get<0>(x.t)};
+ const auto &upperBound{std::get<1>(x.t)};
+
+ // Helper lambda to extract int64 values from a folded array expression
+ auto extractValues = [&](SomeExpr &folded) -> std::vector<std::int64_t> {
+ std::vector<std::int64_t> values;
+ if (auto scalar{evaluate::ToInt64(folded)}) {
+ values.push_back(*scalar);
+ } else if (const auto *someInt{
+ evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeInteger>>(
+ folded)}) {
+ common::visit(
+ [&](const auto &kindExpr) {
+ using T = std::decay_t<decltype(kindExpr)>;
+ if (const auto *constArray{
+ evaluate::UnwrapExpr<evaluate::Constant<typename T::Result>>(
+ kindExpr)}) {
+ for (auto it{constArray->values().begin()};
+ it != constArray->values().end(); ++it) {
+ values.push_back(it->ToInt64());
+ }
+ }
+ },
+ someInt->u);
+ }
+ return values;
+ };
+
+ MaybeExpr ubArrayExpr{AnalyzeExpr(context_, upperBound.thing)};
+ if (!ubArrayExpr) {
+ return;
+ }
+ auto ubFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubArrayExpr))};
+ auto ubValues{extractValues(ubFolded)};
+ if (ubValues.empty()) {
+ return;
+ }
+
+ std::vector<std::int64_t> lbValues;
+ if (lowerBoundOpt) {
+ MaybeExpr lbArrayExpr{AnalyzeExpr(context_, lowerBoundOpt->thing)};
+ if (lbArrayExpr) {
+ auto lbFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbArrayExpr))};
+ lbValues = extractValues(lbFolded);
+ }
+ }
+
+ std::size_t numDims{std::max(ubValues.size(), lbValues.size())};
+ for (std::size_t i{0}; i < numDims; ++i) {
+ Bound lb{1};
+ if (!lbValues.empty()) {
+ std::size_t lbIdx{lbValues.size() == 1 ? 0 : i};
+ lb = Bound{common::Clone(evaluate::ExtentExpr{lbValues[lbIdx]})};
+ }
+ std::size_t ubIdx{ubValues.size() == 1 ? 0 : i};
+ Bound ub{common::Clone(evaluate::ExtentExpr{ubValues[ubIdx]})};
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(std::move(lb), std::move(ub)));
+ }
+}
+
void ArraySpecAnalyzer::Analyze(const parser::AssumedImpliedSpec &x) {
MakeImplied(x.v);
}
diff --git a/flang/test/Semantics/declaration_array_bounds.f90 b/flang/test/Semantics/declaration_array_bounds.f90
new file mode 100644
index 0000000000000..90ae47ec109f9
--- /dev/null
+++ b/flang/test/Semantics/declaration_array_bounds.f90
@@ -0,0 +1,63 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+program declaration_array_bounds
+ implicit none
+
+ ! ---- Valid cases (no errors expected) ----
+
+ ! Scalar bounds (baseline)
+ integer :: a(10)
+ integer :: b(2:10)
+
+ ! Array upper bound only
+ integer :: c([3, 4, 5])
+
+ ! Array lower and upper bounds, same size
+ integer :: d([2, 3] : [10, 20])
+
+ ! Scalar lower, array upper
+ integer :: e(2 : [10, 20])
+
+ ! Array lower, scalar upper
+ integer :: f([2, 3] : 10)
+
+ ! Using non-literal PARAMETER variables
+ integer, parameter :: rank1_parameter_array(3) = [5,5,5]
+ integer :: g(rank1_parameter_array)
+ integer :: ggg(rank1_parameter_array * 2 : rank1_parameter_array - 1)
+
+
+ ! ! Negative cases (erros expected)
+ integer :: rank1_array(3) = [5,5,5]
+ !ERROR: Array (upper) bound must be a constant expression
+ integer :: gg(rank1_array)
+ integer :: scalar
+ !ERROR: Array (lower) bound must be a constant expression
+ !ERROR: Array (upper) bound must be a constant expression
+ integer :: gggg(rank1_parameter_array + rank1_array : rank1_parameter_array * scalar)
+
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ integer :: h([1.2,2.2,3.2]:[1,2,3])
+ !ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
+ integer :: i([1,2,3]:[3,3])
+
+ ! Test error for rank > 1, fulfilling constness
+ integer, parameter :: rank2_parameter_array(2,2) = reshape([[1,2],[3,4]], [2,2])
+ !ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-2
+ integer :: j(rank2_parameter_array)
+ ! Test combined bounds error, first bound as before but second bound as wrong rank
+ ! and nonconst
+ integer :: rank3_array(2,2,2)
+ !ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-2
+ !ERROR: Array (upper) bound must be a constant expression
+ !ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-3
+ integer :: k(rank2_parameter_array : rank3_array)
+
+ ! Test that any comma list is parsed as ExplicitShapeSpecList and not rewritten
+ ! to ExplicitShapeBonudsSpec, giving error messages expecting same number of
+ ! aruments as rank of test_array and scalar integers
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ integer :: test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2)
+end program
\ No newline at end of file
>From 5566f0e5533e9016516725b02e95c0ef9b87a2b9 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Thu, 19 Mar 2026 19:28:18 -0500
Subject: [PATCH 02/32] Add checks and move check.
Remove my const check (for anything not in a subprogram, block, interface, or derived type) and use the existing check.
Check for constant size.
Handle any combination correctly for broadcast.
---
flang/lib/Semantics/resolve-names-utils.cpp | 270 ++++++++++++------
.../Semantics/declaration_array_bounds.f90 | 28 +-
2 files changed, 204 insertions(+), 94 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 9afc1489ea60d..4cb2e2432c761 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -346,92 +346,80 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
std::get<parser::SpecificationExpr>(x.t));
}
-bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x) {
+bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(
+ const parser::ExplicitShapeBoundsSpec &x) {
const auto &lowerBoundOpt{std::get<0>(x.t)};
const auto &upperBound{std::get<1>(x.t)};
- MaybeExpr ubExpr{AnalyzeExpr(context_, upperBound.thing)};
- auto ubFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubExpr))};
- int ubRank{ubFolded.Rank()};
+ bool rankError_{false}, nonConstSizeError_{false};
- bool constError_{false};
- bool rankError_{false};
- if (!evaluate::IsActuallyConstant(ubFolded)) {
- parser::CharBlock at{parser::FindSourceLocation(upperBound)};
- context_.Say(at,
- "Array (upper) bound must be a constant expression"_err_en_US);
- constError_ = true;
+ MaybeExpr ubExpr{AnalyzeExpr(context_, upperBound.thing)};
+ if (!ubExpr) {
+ return false;
}
- if(ubRank > 1) {
+
+ int ubSize{0};
+ if (ubExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context_.foldingContext(), *ubExpr)};
+ shape && shape->size() == 1 && (*shape)[0] &&
+ evaluate::ToInt64(*(*shape)[0])) {
+ ubSize = *evaluate::ToInt64(*(*shape)[0]);
+ } else {
+ context_.Say(parser::FindSourceLocation(upperBound),
+ "Rank-1 integer array used as upper bounds in DECLARATION must have constant size"_err_en_US);
+ nonConstSizeError_ = true;
+ }
+ } else if (ubExpr->Rank() > 1) {
parser::CharBlock at{parser::FindSourceLocation(upperBound)};
context_.Say(at,
- "Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US, ubRank);
+ "Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US,
+ ubExpr->Rank());
rankError_ = true;
}
-
- int lbRank{0};
- std::optional<SomeExpr> lbFolded;
+ int lbSize{0};
if (lowerBoundOpt) {
MaybeExpr lbExpr{AnalyzeExpr(context_, lowerBoundOpt->thing)};
- if (lbExpr) {
- lbFolded = evaluate::Fold(context_.foldingContext(), std::move(*lbExpr));
- lbRank = lbFolded->Rank();
- if (!evaluate::IsActuallyConstant(*lbFolded)) {
- parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
- context_.Say(at,
- "Array (lower) bound must be a constant expression"_err_en_US);
- constError_ = true;
- }
- if(lbRank > 1) {
- parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
- context_.Say(at,
- "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US, lbRank);
- rankError_ = true;
+ if (!lbExpr) {
+ return false;
+ }
+
+ if (lbExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context_.foldingContext(), *lbExpr)};
+ shape && shape->size() == 1 && (*shape)[0] &&
+ evaluate::ToInt64(*(*shape)[0])) {
+ lbSize = *evaluate::ToInt64(*(*shape)[0]);
+ } else {
+ context_.Say(parser::FindSourceLocation(*lowerBoundOpt),
+ "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
+ nonConstSizeError_ = true;
}
+ } else if (lbExpr->Rank() > 1) {
+ parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
+ context_.Say(at,
+ "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US,
+ lbExpr->Rank());
+ rankError_ = true;
}
}
- if(constError_ || rankError_) return false;
-
-
+ if (rankError_ || nonConstSizeError_) {
+ return false;
+ }
- // if both lower and upper bounds are arrays, they must have the same
- // number of elements
- if (lbRank == 1 && ubRank == 1) {
- auto lbShape{evaluate::GetShape(context_.foldingContext(), *lbFolded)};
- auto ubShape{evaluate::GetShape(context_.foldingContext(), ubFolded)};
- if (lbShape && ubShape) {
- auto lbSize{evaluate::GetSize(*lbShape)};
- auto ubSize{evaluate::GetSize(*ubShape)};
- if (lbSize && ubSize) {
- auto lbSizeFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbSize))};
- auto ubSizeFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubSize))};
- auto lbSizeVal{evaluate::ToInt64(lbSizeFolded)};
- auto ubSizeVal{evaluate::ToInt64(ubSizeFolded)};
- if (lbSizeVal && ubSizeVal && *lbSizeVal != *ubSizeVal) {
- parser::CharBlock at{parser::FindSourceLocation(x)};
- context_.Say(at, "DECLARATION bounds integer rank-1 arrays must have the same size; "
- "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
- static_cast<std::intmax_t>(*lbSizeVal),
- static_cast<std::intmax_t>(*ubSizeVal));
- return false;
- }
- }
- }
+ if (lbSize && ubSize && (lbSize != ubSize)) {
+ parser::CharBlock at{parser::FindSourceLocation(x)};
+ context_.Say(at, "DECLARATION bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ lbSize, ubSize);
+ return false;
}
return true;
}
-
-
-
-
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
- if(!checkExplicitShapeBoundsSpec(x)) {
- // push a dummy bound arraySpec_ to satisfy CHECK(!arraySpec_.empty());
- // in ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x).
+ if (!checkExplicitShapeBoundsSpec(x)) {
arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
return;
}
@@ -439,14 +427,27 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
const auto &lowerBoundOpt{std::get<0>(x.t)};
const auto &upperBound{std::get<1>(x.t)};
- // Helper lambda to extract int64 values from a folded array expression
- auto extractValues = [&](SomeExpr &folded) -> std::vector<std::int64_t> {
+ MaybeExpr ubExpr{AnalyzeExpr(context_, upperBound.thing)};
+ if (!ubExpr) {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
+ }
+
+ auto scalarExprToBound = [&](const SomeExpr &expr) -> std::optional<Bound> {
+ if (const auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(expr)}) {
+ auto subscript{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ common::Clone(*intExpr)))};
+ return Bound{MaybeSubscriptIntExpr{std::move(subscript)}};
+ }
+ return std::nullopt;
+ };
+
+ auto extractValues = [&](const SomeExpr &folded) -> std::vector<std::int64_t> {
std::vector<std::int64_t> values;
if (auto scalar{evaluate::ToInt64(folded)}) {
values.push_back(*scalar);
- } else if (const auto *someInt{
- evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeInteger>>(
- folded)}) {
+ } else if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
common::visit(
[&](const auto &kindExpr) {
using T = std::decay_t<decltype(kindExpr)>;
@@ -464,34 +465,131 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
return values;
};
- MaybeExpr ubArrayExpr{AnalyzeExpr(context_, upperBound.thing)};
- if (!ubArrayExpr) {
- return;
- }
- auto ubFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubArrayExpr))};
- auto ubValues{extractValues(ubFolded)};
- if (ubValues.empty()) {
+ auto collectBounds = [&](const SomeExpr &folded) -> std::vector<Bound> {
+ std::vector<Bound> bounds;
+
+ if (folded.Rank() == 0) {
+ if (auto scalar{scalarExprToBound(folded)}) {
+ bounds.push_back(std::move(*scalar));
+ }
+ return bounds;
+ }
+ if (folded.Rank() != 1) {
+ return bounds;
+ }
+
+ // A) Named rank-1 array expr -> build base(lb0+k)
+ if (auto base{evaluate::ExtractNamedEntity(folded)}) {
+ auto shape{evaluate::GetShape(context_.foldingContext(), folded)};
+ auto nExpr{
+ shape ? evaluate::GetSize(*shape) : evaluate::MaybeExtentExpr{}};
+ auto nFolded{
+ nExpr ? evaluate::Fold(context_.foldingContext(), std::move(*nExpr))
+ : evaluate::ExtentExpr{0}};
+ auto n{evaluate::ToInt64(nFolded)};
+ if (n && *n > 0) {
+ auto lb0{evaluate::GetRawLowerBound(context_.foldingContext(), *base, 0)};
+ bounds.reserve(static_cast<std::size_t>(*n));
+ for (std::int64_t k{0}; k < *n; ++k) {
+ auto idx{evaluate::Fold(context_.foldingContext(),
+ common::Clone(lb0) + evaluate::ExtentExpr{
+ static_cast<common::ConstantSubscript>(k)})};
+ std::vector<evaluate::Subscript> subscripts;
+ subscripts.emplace_back(SubscriptIntExpr{std::move(idx)});
+ auto elem{evaluate::AsGenericExpr(evaluate::DataRef{
+ evaluate::ArrayRef{common::Clone(*base), std::move(subscripts)}})};
+ auto b{elem ? scalarExprToBound(*elem) : std::nullopt};
+ if (!b) {
+ bounds.clear();
+ break;
+ }
+ bounds.push_back(std::move(*b));
+ }
+ }
+ }
+
+ // B) Non-constant rank-1 array constructor: [a,b,...]
+ if (bounds.empty()) {
+ if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
+ bool ok{true};
+ common::visit(
+ [&](const auto &kindExpr) {
+ using K = std::decay_t<decltype(kindExpr)>;
+ using R = typename K::Result;
+ if (const auto *ctor{
+ evaluate::UnwrapExpr<evaluate::ArrayConstructor<R>>(kindExpr)}) {
+ for (const auto &value : *ctor) {
+ const auto *elem{std::get_if<evaluate::Expr<R>>(&value.u)};
+ if (!elem || elem->Rank() != 0) {
+ ok = false;
+ return;
+ }
+ SomeIntExpr one{common::Clone(*elem)};
+ auto sub{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ std::move(one)))};
+ bounds.emplace_back(Bound{MaybeSubscriptIntExpr{std::move(sub)}});
+ }
+ }
+ },
+ someInt->u);
+ if (!ok) {
+ bounds.clear();
+ }
+ }
+ }
+
+ // C) Constant rank-1 expression
+ if (bounds.empty()) {
+ auto values{extractValues(folded)};
+ bounds.reserve(values.size());
+ for (auto value : values) {
+ bounds.emplace_back(static_cast<common::ConstantSubscript>(value));
+ }
+ }
+
+ return bounds;
+ };
+
+ auto ubFolded{
+ evaluate::Fold(context_.foldingContext(), std::move(*ubExpr))};
+ std::vector<Bound> ubounds{collectBounds(ubFolded)};
+ if (ubounds.empty()) {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
return;
}
- std::vector<std::int64_t> lbValues;
+ std::vector<Bound> lbounds;
if (lowerBoundOpt) {
- MaybeExpr lbArrayExpr{AnalyzeExpr(context_, lowerBoundOpt->thing)};
- if (lbArrayExpr) {
- auto lbFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbArrayExpr))};
- lbValues = extractValues(lbFolded);
+ if (MaybeExpr lbExpr{AnalyzeExpr(context_, lowerBoundOpt->thing)}) {
+ auto lbFolded{
+ evaluate::Fold(context_.foldingContext(), std::move(*lbExpr))};
+ lbounds = collectBounds(lbFolded);
+ if (lbounds.empty()) {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
+ }
+ } else {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
}
}
- std::size_t numDims{std::max(ubValues.size(), lbValues.size())};
+ if (!lbounds.empty() && ubounds.size() != 1 && lbounds.size() != 1 &&
+ ubounds.size() != lbounds.size()) {
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
+ }
+
+ std::size_t numDims{std::max(ubounds.size(), lbounds.size())};
for (std::size_t i{0}; i < numDims; ++i) {
Bound lb{1};
- if (!lbValues.empty()) {
- std::size_t lbIdx{lbValues.size() == 1 ? 0 : i};
- lb = Bound{common::Clone(evaluate::ExtentExpr{lbValues[lbIdx]})};
+ if (!lbounds.empty()) {
+ std::size_t lbIdx{lbounds.size() == 1 ? 0 : i};
+ lb = lbounds[lbIdx];
}
- std::size_t ubIdx{ubValues.size() == 1 ? 0 : i};
- Bound ub{common::Clone(evaluate::ExtentExpr{ubValues[ubIdx]})};
+ std::size_t ubIdx{ubounds.size() == 1 ? 0 : i};
+ Bound ub{ubounds[ubIdx]};
arraySpec_.push_back(ShapeSpec::MakeExplicit(std::move(lb), std::move(ub)));
}
}
diff --git a/flang/test/Semantics/declaration_array_bounds.f90 b/flang/test/Semantics/declaration_array_bounds.f90
index 90ae47ec109f9..5822c6f1c102c 100644
--- a/flang/test/Semantics/declaration_array_bounds.f90
+++ b/flang/test/Semantics/declaration_array_bounds.f90
@@ -1,4 +1,15 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
+! RUN: %python %S/test_errors.py %s %flang_fc1 -Wautomatic-in-main-program -Wsaved-local-in-spec-expr
+! An explicit-shape-spec or explicit-shape-bounds-spec whose bounds are not constant expressions
+! shall appear only in a subprogram, derived type definition, BLOCK construct, or interface body.
+module data
+ integer :: rank1_array_module(3) = [5, 5, 5]
+ !ERROR: Automatic data object 'gg2' may not appear in a module
+ integer :: gg2(rank1_array_module)
+ integer, allocatable :: nonconstsize(:)
+ !ERROR: Rank-1 integer array used as lower bounds in DECLARATION must have constant size
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: gg3(nonconstsize : nonconstsize)
+end module
program declaration_array_bounds
implicit none
@@ -12,7 +23,7 @@ program declaration_array_bounds
integer :: c([3, 4, 5])
! Array lower and upper bounds, same size
- integer :: d([2, 3] : [10, 20])
+ integer :: d((/2, 3/) : [10, 20])
! Scalar lower, array upper
integer :: e(2 : [10, 20])
@@ -26,14 +37,16 @@ program declaration_array_bounds
integer :: ggg(rank1_parameter_array * 2 : rank1_parameter_array - 1)
- ! ! Negative cases (erros expected)
+ ! Negative cases (erros expected)
integer :: rank1_array(3) = [5,5,5]
- !ERROR: Array (upper) bound must be a constant expression
+ ! Use existing error message for constness checking
+ !PORTABILITY: specification expression refers to local object 'rank1_array' (initialized and saved) [-Wsaved-local-in-spec-expr]
+ !PORTABILITY: Automatic data object 'gg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
integer :: gg(rank1_array)
integer :: scalar
- !ERROR: Array (lower) bound must be a constant expression
- !ERROR: Array (upper) bound must be a constant expression
- integer :: gggg(rank1_parameter_array + rank1_array : rank1_parameter_array * scalar)
+ !ERROR: Invalid specification expression: reference to local entity 'scalar'
+ !PORTABILITY: Automatic data object 'gggg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
+ integer :: gggg(rank1_parameter_array : scalar)
!ERROR: Must have INTEGER type, but is REAL(4)
integer :: h([1.2,2.2,3.2]:[1,2,3])
@@ -48,7 +61,6 @@ program declaration_array_bounds
! and nonconst
integer :: rank3_array(2,2,2)
!ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-2
- !ERROR: Array (upper) bound must be a constant expression
!ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-3
integer :: k(rank2_parameter_array : rank3_array)
>From da267138c9183096ef5ddf72aaaaf28ecb98570e Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Thu, 19 Mar 2026 19:54:06 -0500
Subject: [PATCH 03/32] Add AssumedShapeBoundsSpec node type, and necessary
implementations for successful compilation.
---
flang/include/flang/Parser/dump-parse-tree.h | 1 +
flang/include/flang/Parser/parse-tree.h | 8 +++++---
flang/lib/Parser/unparse.cpp | 1 +
flang/lib/Semantics/resolve-names-utils.cpp | 5 +++++
4 files changed, 12 insertions(+), 3 deletions(-)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 9f4a826fe3f6a..10c356aab0f6e 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -171,6 +171,7 @@ class ParseTreeDumper {
NODE(parser, AssumedImpliedSpec)
NODE(parser, AssumedRankSpec)
NODE(parser, AssumedShapeSpec)
+ NODE(parser, AssumedShapeBoundsSpec)
NODE(parser, AssumedSizeSpec)
NODE(parser, Asynchronous)
NODE(parser, AsynchronousStmt)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index fe5100b1c9c4d..f73f487dbd470 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1325,8 +1325,8 @@ EMPTY_CLASS(AssumedRankSpec);
// R815 array-spec ->
// explicit-shape-spec-list | explicit-shape-bounds-spec |
-// assumed-shape-spec-list | deferred-shape-spec-list |
-// assumed-size-spec | implied-shape-spec |
+// assumed-shape-spec-list | assumed-shape-bounds-spec |
+// deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
// implied-shape-or-assumed-size-spec | assumed-rank-spec
using ExplicitBoundsExpr = IntExpr;
@@ -1337,10 +1337,12 @@ struct ExplicitShapeBoundsSpec {
t;
};
+WRAPPER_CLASS(AssumedShapeBoundsSpec, ExplicitBoundsExpr);
+
struct ArraySpec {
UNION_CLASS_BOILERPLATE(ArraySpec);
std::variant<std::list<ExplicitShapeSpec>, ExplicitShapeBoundsSpec,
- std::list<AssumedShapeSpec>, DeferredShapeSpecList,
+ std::list<AssumedShapeSpec>, AssumedShapeBoundsSpec, DeferredShapeSpecList,
AssumedSizeSpec, ImpliedShapeSpec, AssumedRankSpec>
u;
};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index ec25b0597f443..6d1b66796abad 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -573,6 +573,7 @@ class UnparseVisitor {
[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
[&](const ExplicitShapeBoundsSpec &y) { },
[&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
+ [&](const AssumedShapeBoundsSpec &y) { },
[&](const DeferredShapeSpecList &y) { Walk(y); },
[&](const AssumedSizeSpec &y) { Walk(y); },
[&](const ImpliedShapeSpec &y) { Walk(y); },
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 4cb2e2432c761..ca367529234d4 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -202,6 +202,7 @@ class ArraySpecAnalyzer {
}
}
void Analyze(const parser::AssumedShapeSpec &);
+ void Analyze(const parser::AssumedShapeBoundsSpec &);
void Analyze(const parser::ExplicitShapeSpec &);
void Analyze(const parser::ExplicitShapeBoundsSpec &);
void Analyze(const parser::AssumedImpliedSpec &);
@@ -338,6 +339,10 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
return arraySpec_;
}
+void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
+ ;
+}
+
void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) {
arraySpec_.push_back(ShapeSpec::MakeAssumedShape(GetBound(x.v)));
}
>From 9db2044a4724e7b3b9f05b6e5a8f20484bf80515 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sat, 21 Mar 2026 15:04:06 -0500
Subject: [PATCH 04/32] Working prototype (runtime results). TODO: Move checks
in Analyze to a separate function so that Analyze doesn't have to check
anything.
---
flang/lib/Semantics/resolve-names-utils.cpp | 194 +++++++++++++++++++-
1 file changed, 189 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index ca367529234d4..dbc611d554289 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -241,7 +241,47 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ComponentArraySpec &x) {
return arraySpec_;
}
-static bool shouldRewriteShapeSpecListToExplicitBounds(
+static bool shouldRewriteAssumedShapeSpecListToAssumedBounds(SemanticsContext &context, const parser::ArraySpec &x) {
+ auto &assumedShapeSpecList{std::get<std::list<parser::AssumedShapeSpec>>(
+ const_cast<parser::ArraySpec&>(x).u)};
+
+ if (assumedShapeSpecList.size() != 1) {
+ return false;
+ }
+
+ auto &assumedShapeSpec{assumedShapeSpecList.front()};
+ const auto &lowerBoundOpt{assumedShapeSpec.v};
+
+ bool foundArray{false};
+
+ if (lowerBoundOpt) {
+ const auto &lowerBound{*lowerBoundOpt};
+ if (MaybeExpr analyzedExpr = AnalyzeExpr(context, lowerBound.v.thing.thing.value());
+ analyzedExpr && (analyzedExpr->Rank() > 0)) {
+ foundArray = true;
+ }
+ }
+
+ return foundArray;
+}
+
+static void rewriteAssumedShapeSpecListToAssumedBounds(
+ const parser::ArraySpec &x) {
+ auto &assumedShapeSpecList{
+ std::get<std::list<parser::AssumedShapeSpec>>(
+ const_cast<parser::ArraySpec &>(x).u)};
+ auto &mutableArraySpec{const_cast<parser::ArraySpec &>(x)};
+ auto &mutableAssumedShapeSpec{assumedShapeSpecList.front()};
+
+ auto &lowerBoundOpt{mutableAssumedShapeSpec.v};
+ CHECK(lowerBoundOpt.has_value());
+
+ parser::IntExpr lowerIntExpr{std::move(lowerBoundOpt->v.thing)};
+ parser::AssumedShapeBoundsSpec boundsSpec{std::move(lowerIntExpr)};
+ mutableArraySpec.u = std::move(boundsSpec);
+}
+
+static bool shouldRewriteExplicitShapeSpecListToExplicitBounds(
SemanticsContext &context, const parser::ArraySpec &x) {
auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
const_cast<parser::ArraySpec&>(x).u)};
@@ -272,7 +312,7 @@ static bool shouldRewriteShapeSpecListToExplicitBounds(
return foundArray;
}
-static void rewriteShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
+static void rewriteExplicitShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
const_cast<parser::ArraySpec&>(x).u)};
auto &mutableArraySpec{const_cast<parser::ArraySpec&>(x)};
@@ -299,8 +339,12 @@ static void rewriteShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u) &&
- shouldRewriteShapeSpecListToExplicitBounds(context_, x)) {
- rewriteShapeSpecListToExplicitBounds(x);
+ shouldRewriteExplicitShapeSpecListToExplicitBounds(context_, x)) {
+ rewriteExplicitShapeSpecListToExplicitBounds(x);
+ }
+ else if(std::get_if<std::list<parser::AssumedShapeSpec>>(&x.u) &&
+ shouldRewriteAssumedShapeSpecListToAssumedBounds(context_, x)) {
+ rewriteAssumedShapeSpecListToAssumedBounds(x);
}
common::visit(common::visitors{
[&](const parser::AssumedSizeSpec &y) {
@@ -339,8 +383,148 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
return arraySpec_;
}
+// void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
+// context_.Say("TODO Analyze AssumedShapeBoundsSpec"_err_en_US);
+// arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
+// }
+
void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
- ;
+ MaybeExpr lbExpr{AnalyzeExpr(context_, x.v.thing)};
+ if (!lbExpr) {
+ arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
+ return;
+ }
+
+ if (lbExpr->Rank() != 1) {
+ parser::CharBlock at{parser::FindSourceLocation(x)};
+ context_.Say(at,
+ "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US,
+ lbExpr->Rank());
+ arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
+ return;
+ }
+
+ auto extractValues = [&](const SomeExpr &folded) -> std::vector<std::int64_t> {
+ std::vector<std::int64_t> values;
+ if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
+ common::visit(
+ [&](const auto &kindExpr) {
+ using T = std::decay_t<decltype(kindExpr)>;
+ if (const auto *constArray{
+ evaluate::UnwrapExpr<evaluate::Constant<typename T::Result>>(
+ kindExpr)}) {
+ for (auto it{constArray->values().begin()};
+ it != constArray->values().end(); ++it) {
+ values.push_back(it->ToInt64());
+ }
+ }
+ },
+ someInt->u);
+ }
+ return values;
+ };
+
+ auto collectBounds = [&](const SomeExpr &folded) -> std::vector<Bound> {
+ std::vector<Bound> bounds;
+
+ // A) Named rank-1 array expr -> build base(lb0+k)
+ if (auto base{evaluate::ExtractNamedEntity(folded)}) {
+ auto shape{evaluate::GetShape(context_.foldingContext(), folded)};
+ auto nExpr{
+ shape ? evaluate::GetSize(*shape) : evaluate::MaybeExtentExpr{}};
+ auto nFolded{
+ nExpr ? evaluate::Fold(context_.foldingContext(), std::move(*nExpr))
+ : evaluate::ExtentExpr{0}};
+ auto n{evaluate::ToInt64(nFolded)};
+ if (!n) {
+ context_.Say(parser::FindSourceLocation(x),
+ "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
+ return bounds;
+ }
+ if (*n <= 0) {
+ return bounds;
+ }
+
+ auto lb0{evaluate::GetRawLowerBound(context_.foldingContext(), *base, 0)};
+ bounds.reserve(static_cast<std::size_t>(*n));
+ for (std::int64_t k{0}; k < *n; ++k) {
+ auto idx{evaluate::Fold(context_.foldingContext(),
+ common::Clone(lb0) + evaluate::ExtentExpr{
+ static_cast<common::ConstantSubscript>(k)})};
+ std::vector<evaluate::Subscript> subscripts;
+ subscripts.emplace_back(SubscriptIntExpr{std::move(idx)});
+ auto elem{evaluate::AsGenericExpr(evaluate::DataRef{
+ evaluate::ArrayRef{common::Clone(*base), std::move(subscripts)}})};
+ if (!elem) {
+ bounds.clear();
+ return bounds;
+ }
+ const auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*elem)};
+ if (!intExpr) {
+ bounds.clear();
+ return bounds;
+ }
+ auto subscript{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ common::Clone(*intExpr)))};
+ bounds.emplace_back(Bound{MaybeSubscriptIntExpr{std::move(subscript)}});
+ }
+ return bounds;
+ }
+
+ // B) Non-constant rank-1 array constructor: [a,b,...]
+ if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
+ bool sawCtor{false};
+ bool ok{true};
+ common::visit(
+ [&](const auto &kindExpr) {
+ using K = std::decay_t<decltype(kindExpr)>;
+ using R = typename K::Result;
+ if (const auto *ctor{
+ evaluate::UnwrapExpr<evaluate::ArrayConstructor<R>>(kindExpr)}) {
+ sawCtor = true;
+ for (const auto &value : *ctor) {
+ const auto *elem{std::get_if<evaluate::Expr<R>>(&value.u)};
+ if (!elem || elem->Rank() != 0) {
+ ok = false;
+ return;
+ }
+ SomeIntExpr one{common::Clone(*elem)};
+ auto sub{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ std::move(one)))};
+ bounds.emplace_back(Bound{MaybeSubscriptIntExpr{std::move(sub)}});
+ }
+ }
+ },
+ someInt->u);
+ if (sawCtor) {
+ if (!ok) {
+ bounds.clear();
+ }
+ return bounds;
+ }
+ }
+
+ // C) Constant rank-1 expression
+ auto values{extractValues(folded)};
+ bounds.reserve(values.size());
+ for (auto value : values) {
+ bounds.emplace_back(static_cast<common::ConstantSubscript>(value));
+ }
+ return bounds;
+ };
+
+ auto lbFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbExpr))};
+ std::vector<Bound> lbounds{collectBounds(lbFolded)};
+ if (lbounds.empty()) {
+ arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
+ return;
+ }
+
+ for (auto &lb : lbounds) {
+ arraySpec_.push_back(ShapeSpec::MakeAssumedShape(std::move(lb)));
+ }
}
void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) {
>From 1f84c06095ec215f16d230a280c8a3d56cd28037 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sat, 21 Mar 2026 15:06:12 -0500
Subject: [PATCH 05/32] Delete commented out prototype
---
flang/lib/Semantics/resolve-names-utils.cpp | 5 -----
1 file changed, 5 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index dbc611d554289..10fe8a185b4ee 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -383,11 +383,6 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
return arraySpec_;
}
-// void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
-// context_.Say("TODO Analyze AssumedShapeBoundsSpec"_err_en_US);
-// arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
-// }
-
void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
MaybeExpr lbExpr{AnalyzeExpr(context_, x.v.thing)};
if (!lbExpr) {
>From a2d1477e7a762f1877b9795246e33beb7c6af224 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 23 Mar 2026 10:49:27 -0500
Subject: [PATCH 06/32] Add support for arbitrary expressions, add test for
valid cases. Go back and clean this up.
---
flang/lib/Semantics/resolve-names-utils.cpp | 138 ++++++++++++++++--
.../declaration_assumed_array_bounds.f90 | 14 ++
2 files changed, 142 insertions(+), 10 deletions(-)
create mode 100644 flang/test/Semantics/declaration_assumed_array_bounds.f90
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 10fe8a185b4ee..2ff70decb63df 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -22,9 +22,43 @@
#include "flang/Support/Fortran.h"
#include <initializer_list>
#include <variant>
+#include "flang/Evaluate/rewrite.h"
+#include "flang/Semantics/type.h"
namespace Fortran::semantics {
+struct RankOneArrayElementSubstituter {
+ const std::vector<std::pair<const Symbol *, SubscriptIntExpr>> &subscripts;
+
+ template <typename T, typename U>
+ evaluate::Expr<T> operator()(evaluate::Expr<T> &&x, const U &) const {
+ return std::move(x);
+ }
+
+ template <typename T>
+ evaluate::Expr<T> operator()(
+ evaluate::Expr<T> &&x,
+ const evaluate::Designator<T> &designator) const {
+ if (designator.Rank() != 1) {
+ return std::move(x);
+ }
+ const Symbol *last{designator.GetLastSymbol()};
+ if (!last) {
+ return std::move(x);
+ }
+ for (const auto &[symbol, subscript] : subscripts) {
+ if (last == symbol) {
+ std::vector<evaluate::Subscript> scalarSubscripts;
+ scalarSubscripts.emplace_back(common::Clone(subscript));
+ evaluate::DataRef dataRef{
+ evaluate::ArrayRef{*symbol, std::move(scalarSubscripts)}};
+ return evaluate::Expr<T>{evaluate::Designator<T>{std::move(dataRef)}};
+ }
+ }
+ return std::move(x);
+ }
+};
+
using common::LanguageFeature;
using common::LogicalOperator;
using common::NumericOperator;
@@ -399,7 +433,8 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
return;
}
- auto extractValues = [&](const SomeExpr &folded) -> std::vector<std::int64_t> {
+ auto extractValues =
+ [&](const SomeExpr &folded) -> std::vector<std::int64_t> {
std::vector<std::int64_t> values;
if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
common::visit(
@@ -408,9 +443,8 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
if (const auto *constArray{
evaluate::UnwrapExpr<evaluate::Constant<typename T::Result>>(
kindExpr)}) {
- for (auto it{constArray->values().begin()};
- it != constArray->values().end(); ++it) {
- values.push_back(it->ToInt64());
+ for (const auto &value : constArray->values()) {
+ values.push_back(value.ToInt64());
}
}
},
@@ -422,7 +456,7 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
auto collectBounds = [&](const SomeExpr &folded) -> std::vector<Bound> {
std::vector<Bound> bounds;
- // A) Named rank-1 array expr -> build base(lb0+k)
+ // A) Bare named rank-1 array expr -> build base(lb0+k)
if (auto base{evaluate::ExtractNamedEntity(folded)}) {
auto shape{evaluate::GetShape(context_.foldingContext(), folded)};
auto nExpr{
@@ -476,7 +510,8 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
using K = std::decay_t<decltype(kindExpr)>;
using R = typename K::Result;
if (const auto *ctor{
- evaluate::UnwrapExpr<evaluate::ArrayConstructor<R>>(kindExpr)}) {
+ evaluate::UnwrapExpr<evaluate::ArrayConstructor<R>>(
+ kindExpr)}) {
sawCtor = true;
for (const auto &value : *ctor) {
const auto *elem{std::get_if<evaluate::Expr<R>>(&value.u)};
@@ -488,7 +523,8 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
auto sub{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
std::move(one)))};
- bounds.emplace_back(Bound{MaybeSubscriptIntExpr{std::move(sub)}});
+ bounds.emplace_back(
+ Bound{MaybeSubscriptIntExpr{std::move(sub)}});
}
}
},
@@ -503,10 +539,92 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
// C) Constant rank-1 expression
auto values{extractValues(folded)};
- bounds.reserve(values.size());
- for (auto value : values) {
- bounds.emplace_back(static_cast<common::ConstantSubscript>(value));
+ if (!values.empty()) {
+ bounds.reserve(values.size());
+ for (auto value : values) {
+ bounds.emplace_back(static_cast<common::ConstantSubscript>(value));
+ }
+ return bounds;
+ }
+
+ // D) General rank-1 elemental expression over rank-1 arrays: dim_a + 2
+ auto shape{evaluate::GetShape(context_.foldingContext(), folded)};
+ auto nExpr{
+ shape ? evaluate::GetSize(*shape) : evaluate::MaybeExtentExpr{}};
+ auto nFolded{
+ nExpr ? evaluate::Fold(context_.foldingContext(), std::move(*nExpr))
+ : evaluate::ExtentExpr{0}};
+ auto n{evaluate::ToInt64(nFolded)};
+ if (!n) {
+ context_.Say(parser::FindSourceLocation(x),
+ "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
+ return bounds;
+ }
+ if (*n <= 0) {
+ return bounds;
}
+
+ std::vector<const Symbol *> rankOneSymbols;
+ for (const semantics::SymbolRef ref : evaluate::CollectSymbols(folded)) {
+ const Symbol &symbol{ref.get()};
+ if (const ArraySpec *shape{symbol.GetShape()};
+ shape && shape->Rank() == 1) {
+ rankOneSymbols.push_back(&symbol);
+ }
+ }
+ if (rankOneSymbols.empty()) {
+ return bounds;
+ }
+
+ const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)};
+ if (!someInt) {
+ return bounds;
+ }
+
+ bounds.reserve(static_cast<std::size_t>(*n));
+ for (std::int64_t k{0}; k < *n; ++k) {
+ std::vector<std::pair<const Symbol *, SubscriptIntExpr>>
+ elementSubscripts;
+ elementSubscripts.reserve(rankOneSymbols.size());
+ for (const Symbol *symbol : rankOneSymbols) {
+ evaluate::NamedEntity base{*symbol};
+ auto lb0{
+ evaluate::GetRawLowerBound(context_.foldingContext(), base, 0)};
+ auto idx{evaluate::Fold(context_.foldingContext(),
+ common::Clone(lb0) + evaluate::ExtentExpr{
+ static_cast<common::ConstantSubscript>(k)})};
+ elementSubscripts.emplace_back(
+ symbol, SubscriptIntExpr{std::move(idx)});
+ }
+
+ RankOneArrayElementSubstituter rewriter{elementSubscripts};
+ std::optional<Bound> elementBound;
+ bool ok{true};
+
+ common::visit(
+ [&](const auto &kindExpr) {
+ auto scalarized{
+ evaluate::rewrite::Mutator{rewriter}(common::Clone(kindExpr))};
+ if (scalarized.Rank() != 0) {
+ ok = false;
+ return;
+ }
+ SomeIntExpr one{std::move(scalarized)};
+ auto sub{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ std::move(one)))};
+ elementBound.emplace(
+ Bound{MaybeSubscriptIntExpr{std::move(sub)}});
+ },
+ someInt->u);
+
+ if (!ok || !elementBound) {
+ bounds.clear();
+ return bounds;
+ }
+ bounds.push_back(std::move(*elementBound));
+ }
+
return bounds;
};
diff --git a/flang/test/Semantics/declaration_assumed_array_bounds.f90 b/flang/test/Semantics/declaration_assumed_array_bounds.f90
new file mode 100644
index 0000000000000..908c9c1d83a49
--- /dev/null
+++ b/flang/test/Semantics/declaration_assumed_array_bounds.f90
@@ -0,0 +1,14 @@
+program main
+ implicit none
+contains
+ subroutine foo_a(x, y, z, dim_a)
+ integer :: dim_a(1)
+ !valid cases
+ !simple rank-1 integer array reference
+ integer :: x(dim_a:)
+ !rank-1 integer array + scalar = rank-1 integer array
+ integer :: y(dim_a + 2:)
+ !rank-1 integer array via array constructor literal, with some non-const values
+ integer :: z([1,2,dim_a(1) + x(dim_a(1))])
+ end subroutine
+end program
>From 893cf417a5fdbe38656bd985fe63012a9ce05275 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 23 Mar 2026 12:06:49 -0500
Subject: [PATCH 07/32] Separate checks from Analyze, add negative test cases
---
flang/lib/Semantics/resolve-names-utils.cpp | 114 +++++++-----------
.../declaration_assumed_array_bounds.f90 | 21 +++-
2 files changed, 62 insertions(+), 73 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 2ff70decb63df..ef7de1a35c1a2 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -249,6 +249,7 @@ class ArraySpecAnalyzer {
Bound GetBound(const std::optional<parser::SpecificationExpr> &);
Bound GetBound(const parser::SpecificationExpr &);
bool checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x);
+ bool checkAssumedShapeBoundsSpec(const parser::AssumedShapeBoundsSpec &x);
};
ArraySpec AnalyzeArraySpec(
@@ -418,21 +419,12 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::CoarraySpec &x) {
}
void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
- MaybeExpr lbExpr{AnalyzeExpr(context_, x.v.thing)};
- if (!lbExpr) {
- arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
- return;
- }
-
- if (lbExpr->Rank() != 1) {
- parser::CharBlock at{parser::FindSourceLocation(x)};
- context_.Say(at,
- "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US,
- lbExpr->Rank());
+ if(!checkAssumedShapeBoundsSpec(x)) {
arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
return;
}
+ MaybeExpr lbExpr{AnalyzeExpr(context_, x.v.thing)};
auto extractValues =
[&](const SomeExpr &folded) -> std::vector<std::int64_t> {
std::vector<std::int64_t> values;
@@ -464,19 +456,12 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
auto nFolded{
nExpr ? evaluate::Fold(context_.foldingContext(), std::move(*nExpr))
: evaluate::ExtentExpr{0}};
- auto n{evaluate::ToInt64(nFolded)};
- if (!n) {
- context_.Say(parser::FindSourceLocation(x),
- "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
- return bounds;
- }
- if (*n <= 0) {
- return bounds;
- }
+ auto n{*evaluate::ToInt64(nFolded)};
- auto lb0{evaluate::GetRawLowerBound(context_.foldingContext(), *base, 0)};
- bounds.reserve(static_cast<std::size_t>(*n));
- for (std::int64_t k{0}; k < *n; ++k) {
+ bounds.reserve(static_cast<std::size_t>(n));
+ for (std::int64_t k{0}; k < n; ++k) {
+ auto lb0{
+ evaluate::GetRawLowerBound(context_.foldingContext(), *base, 0)};
auto idx{evaluate::Fold(context_.foldingContext(),
common::Clone(lb0) + evaluate::ExtentExpr{
static_cast<common::ConstantSubscript>(k)})};
@@ -484,15 +469,7 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
subscripts.emplace_back(SubscriptIntExpr{std::move(idx)});
auto elem{evaluate::AsGenericExpr(evaluate::DataRef{
evaluate::ArrayRef{common::Clone(*base), std::move(subscripts)}})};
- if (!elem) {
- bounds.clear();
- return bounds;
- }
const auto *intExpr{evaluate::UnwrapExpr<SomeIntExpr>(*elem)};
- if (!intExpr) {
- bounds.clear();
- return bounds;
- }
auto subscript{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
common::Clone(*intExpr)))};
@@ -504,7 +481,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
// B) Non-constant rank-1 array constructor: [a,b,...]
if (const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)}) {
bool sawCtor{false};
- bool ok{true};
common::visit(
[&](const auto &kindExpr) {
using K = std::decay_t<decltype(kindExpr)>;
@@ -515,10 +491,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
sawCtor = true;
for (const auto &value : *ctor) {
const auto *elem{std::get_if<evaluate::Expr<R>>(&value.u)};
- if (!elem || elem->Rank() != 0) {
- ok = false;
- return;
- }
SomeIntExpr one{common::Clone(*elem)};
auto sub{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
@@ -530,9 +502,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
},
someInt->u);
if (sawCtor) {
- if (!ok) {
- bounds.clear();
- }
return bounds;
}
}
@@ -554,15 +523,7 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
auto nFolded{
nExpr ? evaluate::Fold(context_.foldingContext(), std::move(*nExpr))
: evaluate::ExtentExpr{0}};
- auto n{evaluate::ToInt64(nFolded)};
- if (!n) {
- context_.Say(parser::FindSourceLocation(x),
- "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
- return bounds;
- }
- if (*n <= 0) {
- return bounds;
- }
+ auto n{*evaluate::ToInt64(nFolded)};
std::vector<const Symbol *> rankOneSymbols;
for (const semantics::SymbolRef ref : evaluate::CollectSymbols(folded)) {
@@ -572,17 +533,10 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
rankOneSymbols.push_back(&symbol);
}
}
- if (rankOneSymbols.empty()) {
- return bounds;
- }
const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)};
- if (!someInt) {
- return bounds;
- }
-
- bounds.reserve(static_cast<std::size_t>(*n));
- for (std::int64_t k{0}; k < *n; ++k) {
+ bounds.reserve(static_cast<std::size_t>(n));
+ for (std::int64_t k{0}; k < n; ++k) {
std::vector<std::pair<const Symbol *, SubscriptIntExpr>>
elementSubscripts;
elementSubscripts.reserve(rankOneSymbols.size());
@@ -599,16 +553,11 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
RankOneArrayElementSubstituter rewriter{elementSubscripts};
std::optional<Bound> elementBound;
- bool ok{true};
common::visit(
[&](const auto &kindExpr) {
auto scalarized{
evaluate::rewrite::Mutator{rewriter}(common::Clone(kindExpr))};
- if (scalarized.Rank() != 0) {
- ok = false;
- return;
- }
SomeIntExpr one{std::move(scalarized)};
auto sub{evaluate::Fold(context_.foldingContext(),
evaluate::ConvertToType<evaluate::SubscriptInteger>(
@@ -618,10 +567,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
},
someInt->u);
- if (!ok || !elementBound) {
- bounds.clear();
- return bounds;
- }
bounds.push_back(std::move(*elementBound));
}
@@ -630,11 +575,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeBoundsSpec &x) {
auto lbFolded{evaluate::Fold(context_.foldingContext(), std::move(*lbExpr))};
std::vector<Bound> lbounds{collectBounds(lbFolded)};
- if (lbounds.empty()) {
- arraySpec_.push_back(ShapeSpec::MakeAssumedShape(Bound{1}));
- return;
- }
-
for (auto &lb : lbounds) {
arraySpec_.push_back(ShapeSpec::MakeAssumedShape(std::move(lb)));
}
@@ -648,6 +588,38 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
std::get<parser::SpecificationExpr>(x.t));
}
+bool ArraySpecAnalyzer::checkAssumedShapeBoundsSpec(
+ const parser::AssumedShapeBoundsSpec &x) {
+ MaybeExpr lbExpr{AnalyzeExpr(context_, x.v.thing)};
+ if (!lbExpr) {
+ return false;
+ }
+
+ bool rankError{false}, nonConstSizeError{false};
+
+ if (lbExpr->Rank() != 1) {
+ parser::CharBlock at{parser::FindSourceLocation(x)};
+ context_.Say(at,
+ "Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US,
+ lbExpr->Rank());
+ rankError = true;
+ }
+
+ auto shape{evaluate::GetShape(context_.foldingContext(), *lbExpr)};
+ auto sizeExpr{
+ shape ? evaluate::GetSize(*shape) : evaluate::MaybeExtentExpr{}};
+ auto sizeFolded{
+ sizeExpr ? evaluate::Fold(context_.foldingContext(), std::move(*sizeExpr))
+ : evaluate::ExtentExpr{0}};
+ if (!evaluate::ToInt64(sizeFolded)) {
+ context_.Say(parser::FindSourceLocation(x),
+ "Rank-1 integer array used as lower bounds in DECLARATION must have constant size"_err_en_US);
+ nonConstSizeError = true;
+ }
+
+ return !(rankError || nonConstSizeError);
+}
+
bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(
const parser::ExplicitShapeBoundsSpec &x) {
const auto &lowerBoundOpt{std::get<0>(x.t)};
diff --git a/flang/test/Semantics/declaration_assumed_array_bounds.f90 b/flang/test/Semantics/declaration_assumed_array_bounds.f90
index 908c9c1d83a49..f0f01fab57fd6 100644
--- a/flang/test/Semantics/declaration_assumed_array_bounds.f90
+++ b/flang/test/Semantics/declaration_assumed_array_bounds.f90
@@ -1,7 +1,8 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
program main
implicit none
contains
- subroutine foo_a(x, y, z, dim_a)
+ subroutine good(x, y, z, dim_a)
integer :: dim_a(1)
!valid cases
!simple rank-1 integer array reference
@@ -9,6 +10,22 @@ subroutine foo_a(x, y, z, dim_a)
!rank-1 integer array + scalar = rank-1 integer array
integer :: y(dim_a + 2:)
!rank-1 integer array via array constructor literal, with some non-const values
- integer :: z([1,2,dim_a(1) + x(dim_a(1))])
+ integer :: z([1,2,dim_a(1) + x(dim_a(1))]:)
+ end subroutine
+
+ subroutine bad(x, y, z, dim1_assumed, dim2_assumed)
+ integer :: dim3(3, 3, 3)
+ integer :: dim1_assumed(:)
+ integer :: dim2_assumed(:,:)
+ ! ERROR: Rank-1 integer array used as lower bounds in DECLARATION must have constant size
+ integer :: x(dim1_assumed:)
+ ! ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-3
+ integer :: y(dim3:)
+ ! Combining both errors in one declaration, plus integer-check from
+ ! type wrapper
+ ! ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-2
+ ! ERROR: Rank-1 integer array used as lower bounds in DECLARATION must have constant size
+ ! ERROR: Must have INTEGER type, but is REAL(4)
+ integer :: z(dim2_assumed + 3.7:)
end subroutine
end program
>From c1208ef26fa9614a2cc27f33beb15da694a158a4 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 13 Jan 2026 01:30:04 -0600
Subject: [PATCH 08/32] Maintain previous behavior after changing parse tree
structure and uses.
---
flang/examples/FeatureList/FeatureList.cpp | 2 +
flang/include/flang/Parser/dump-parse-tree.h | 2 +
flang/include/flang/Parser/parse-tree.h | 47 ++++++++++++++++++--
flang/include/flang/Semantics/expression.h | 2 +-
flang/lib/Lower/Allocatable.cpp | 3 +-
flang/lib/Parser/unparse.cpp | 2 +-
flang/lib/Semantics/check-allocate.cpp | 6 +--
7 files changed, 54 insertions(+), 10 deletions(-)
diff --git a/flang/examples/FeatureList/FeatureList.cpp b/flang/examples/FeatureList/FeatureList.cpp
index 355d79a04e4ba..0b76d141da4ec 100644
--- a/flang/examples/FeatureList/FeatureList.cpp
+++ b/flang/examples/FeatureList/FeatureList.cpp
@@ -117,6 +117,8 @@ struct NodeVisitor {
READ_FEATURE(AllocatableStmt)
READ_FEATURE(AllocateCoarraySpec)
READ_FEATURE(AllocateObject)
+ READ_FEATURE(AllocateShapeSpecArray)
+ READ_FEATURE(AllocateShapeSpecArrayList)
READ_FEATURE(AllocateShapeSpec)
READ_FEATURE(AllocateStmt)
READ_FEATURE(Allocation)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index 10c356aab0f6e..0f85090507aad 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -154,6 +154,8 @@ class ParseTreeDumper {
NODE(parser, AllocatableStmt)
NODE(parser, AllocateCoarraySpec)
NODE(parser, AllocateObject)
+ NODE(parser, AllocateShapeSpecArray)
+ NODE(parser, AllocateShapeSpecArrayList)
NODE(parser, AllocateShapeSpec)
NODE(parser, AllocateStmt)
NODE(parser, Allocation)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index f73f487dbd470..7219ea40b897c 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1918,6 +1918,10 @@ struct AllocateObject {
// R936 upper-bound-expr -> scalar-int-expr
using BoundExpr = ScalarIntExpr;
+// R937 lower-bounds-expr -> int-expr
+// R939 upper-bounds-expr -> int-expr
+using BoundsExpr = IntExpr;
+
// R934 allocate-shape-spec -> [lower-bound-expr :] upper-bound-expr
// R938 allocate-coshape-spec -> [lower-bound-expr :] upper-bound-expr
struct AllocateShapeSpec {
@@ -1934,14 +1938,49 @@ struct AllocateCoarraySpec {
std::tuple<std::list<AllocateCoshapeSpec>, std::optional<BoundExpr>> t;
};
-// R932 allocation ->
+// R933 allocation ->
// allocate-object [( allocate-shape-spec-list )]
// [lbracket allocate-coarray-spec rbracket]
+// | allocate-object ( allocate-shape-spec-array )
+// [lbracket allocate-coarray-spec rbracket]
+// allocate-shape-spec-array -> [ lower-bounds-expr : ] upper-bounds-expr
+struct AllocateShapeSpecArray {
+ TUPLE_CLASS_BOILERPLATE(AllocateShapeSpecArray);
+ std::tuple<
+ std::optional<BoundsExpr>,
+ BoundsExpr>
+ t;
+};
+
+struct AllocateShapeSpecArrayList {
+ UNION_CLASS_BOILERPLATE(AllocateShapeSpecArrayList);
+ std::variant<
+ std::list<AllocateShapeSpec>,
+ AllocateShapeSpecArray>
+ u;
+};
struct Allocation {
TUPLE_CLASS_BOILERPLATE(Allocation);
- std::tuple<AllocateObject, std::list<AllocateShapeSpec>,
- std::optional<AllocateCoarraySpec>>
- t;
+ // What was previously there but I formatted it.
+ // std::tuple<
+ // AllocateObject,
+ // std::list<AllocateShapeSpec>,
+ // std::optional<AllocateCoarraySpec>
+ // >
+ // I think this is what I want but can't have nested tuples.
+ // Use a wrapper on innermost tuple.
+ // std::tuple<
+ // AllocateObject,
+ // std::variant<
+ // std::list<AllocateShapeSpec>,
+ // std::tuple<std::optional<BoundsExpr>, BoundsExpr>,
+ // std::optional<AllocateCoarraySpec>>
+ // t;
+ std::tuple<
+ AllocateObject,
+ AllocateShapeSpecArrayList,
+ std::optional<AllocateCoarraySpec>>
+ t;
};
// R929 stat-variable -> scalar-int-variable
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 490399aa03ff8..ba075b2ed2fb6 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -185,7 +185,7 @@ class ExpressionAnalyzer {
template <typename A> MaybeExpr Analyze(const parser::Scalar<A> &x) {
auto result{Analyze(x.thing)};
if (result) {
- if (int rank{result->Rank()}; rank != 0) {
+ if (int rank{result->Rank()}; rank != 0 ) { //&& (rank != 1)) {
SayAt(x, "Must be a scalar value, but is a rank-%d array"_err_en_US,
rank);
ResetExpr(x);
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 1912027f8742d..a46dc0f3da9d7 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -337,7 +337,8 @@ class AllocateStmtHelper {
return unwrapSymbol(getAllocObj());
}
const std::list<Fortran::parser::AllocateShapeSpec> &getShapeSpecs() const {
- return std::get<std::list<Fortran::parser::AllocateShapeSpec>>(alloc.t);
+ return std::get<std::list<Fortran::parser::AllocateShapeSpec>>((std::get<Fortran::parser::AllocateShapeSpecArrayList>(alloc.t)).u);
+ // return std::get<std::list<Fortran::parser::AllocateShapeSpec>>(alloc.t);
}
};
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 6d1b66796abad..ab20ac2a91728 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -851,7 +851,7 @@ class UnparseVisitor {
}
void Unparse(const Allocation &x) { // R932
Walk(std::get<AllocateObject>(x.t));
- Walk("(", std::get<std::list<AllocateShapeSpec>>(x.t), ",", ")");
+ Walk("(", std::get<std::list<AllocateShapeSpec>>(std::get<AllocateShapeSpecArrayList>(x.t).u), ",", ")");
Walk("[", std::get<std::optional<AllocateCoarraySpec>>(x.t), "]");
}
void Unparse(const AllocateShapeSpec &x) { // R934 & R938
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 7f099d51221c0..5a1840dfbf619 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -59,7 +59,7 @@ class AllocationCheckerHelper {
static int ShapeSpecRank(const parser::Allocation &allocation) {
return static_cast<int>(
- std::get<std::list<parser::AllocateShapeSpec>>(allocation.t).size());
+ std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation.t)).u).size());
}
static int CoarraySpecRank(const parser::Allocation &allocation) {
@@ -600,7 +600,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
} else {
// explicit shape-spec-list
- if (allocateShapeSpecRank_ != rank_) {
+ if (allocateShapeSpecRank_ != rank_) { printf("got to allocateShapeSpecRank_ %d != rank_ %d\n", allocateShapeSpecRank_, rank_);
context
.Say(name_.source,
"The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
@@ -612,7 +612,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
static_cast<std::size_t>(allocateShapeSpecRank_)) {
std::size_t j{0};
for (const auto &shapeSpec :
- std::get<std::list<parser::AllocateShapeSpec>>(allocation_.t)) {
+ std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)).u)) {
if (j >= allocateInfo_.sourceExprShape->size()) {
break;
}
>From db8c9aa6a99e231b35039a1441a930076af00a7c Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 16 Jan 2026 00:57:50 -0600
Subject: [PATCH 09/32] Implement rank-1 array as shape specification by
lowering integer arrays to individual AllocateShapeSpec entries in
Allocation's std::list<AllocateShapeSpec>. TODO: Undo the changes to
parse-tree.h because I ended up not needed a new symbol by using this
strategy of breaking this apart since integer array has to be constant size.
Also TODO: handle identifiers, which I think can be broken down similarly but
each individual entry should be populated with dims(1), dims(2), ...
---
flang/include/flang/Semantics/expression.h | 7 ++-
flang/lib/Semantics/check-allocate.cpp | 2 +-
flang/lib/Semantics/expression.cpp | 53 ++++++++++++++++++++++
3 files changed, 60 insertions(+), 2 deletions(-)
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index ba075b2ed2fb6..37e1f25b0fd1b 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -185,7 +185,7 @@ class ExpressionAnalyzer {
template <typename A> MaybeExpr Analyze(const parser::Scalar<A> &x) {
auto result{Analyze(x.thing)};
if (result) {
- if (int rank{result->Rank()}; rank != 0 ) { //&& (rank != 1)) {
+ if (int rank{result->Rank()}; rank != 0) {
SayAt(x, "Must be a scalar value, but is a rank-%d array"_err_en_US,
rank);
ResetExpr(x);
@@ -251,6 +251,7 @@ class ExpressionAnalyzer {
MaybeExpr Analyze(const parser::InitialDataTarget &);
MaybeExpr Analyze(const parser::NullInit &);
MaybeExpr Analyze(const parser::StmtFunctionStmt &);
+ MaybeExpr Analyze(const parser::Allocation &);
void Analyze(const parser::CallStmt &);
const Assignment *Analyze(const parser::AssignmentStmt &);
@@ -503,6 +504,10 @@ class ExprChecker {
AnalyzeAndNoteUses(x, /*isDefinition=*/true);
return false;
}
+ bool Pre(const parser::Allocation &x) {
+ exprAnalyzer_.Analyze(x);
+ return true;
+ }
bool Pre(const parser::DataStmtObject &);
void Post(const parser::DataStmtObject &);
bool Pre(const parser::DataImpliedDo &);
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 5a1840dfbf619..5d2015b87d378 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -600,7 +600,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
} else {
// explicit shape-spec-list
- if (allocateShapeSpecRank_ != rank_) { printf("got to allocateShapeSpecRank_ %d != rank_ %d\n", allocateShapeSpecRank_, rank_);
+ if (allocateShapeSpecRank_ != rank_) {
context
.Say(name_.source,
"The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 457c5a3594f6d..8c3e9810a2ec2 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4377,6 +4377,59 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
return ExprOrVariable(x, parser::FindSourceLocation(x));
}
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
+ auto &shapeSpecList{
+ std::get<std::list<parser::AllocateShapeSpec>>(
+ (std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
+
+ if (shapeSpecList.empty()) {
+ return std::nullopt;
+ }
+
+ const auto &shapeSpec{shapeSpecList.front()};
+ auto &expr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
+
+ if (const auto *arrayConstructor{
+ std::get_if<parser::ArrayConstructor>(&expr.u)}) {
+
+ const auto &acSpec{arrayConstructor->v}; // AcSpec
+ std::list<parser::AllocateShapeSpec> newShapeSpecs;
+
+ // Iterate through array constructor values
+ for (const auto &acValue : acSpec.values) {
+ if (const auto *indirExpr =
+ std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
+
+ // Create new BoundExpr wrapping a reference to the expression
+ // Don't copy - use the existing indirection
+ parser::BoundExpr newBoundExpr{
+ parser::Integer(std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
+
+ // Create new AllocateShapeSpec with optional lower bound and upper bound
+ parser::AllocateShapeSpec newSpec =
+ std::make_tuple(
+ std::optional<parser::BoundExpr>{},
+ std::move(newBoundExpr));
+
+ newShapeSpecs.push_back(std::move(newSpec));
+ }
+ }
+
+ // Replace the original list with expanded specs
+ auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
+ mutableShapeSpecList.clear();
+ mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
+
+ // printf("printing tree from allocation_ node\n");
+
+ // std::string buf;
+ // llvm::raw_string_ostream dump{buf};
+ // Fortran::parser::DumpTree(dump, x);
+ // std::cout << buf << std::endl;
+ }
+ return std::nullopt;
+}
+
Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
TypeCategory category,
const std::optional<parser::KindSelector> &selector) {
>From 4698993796d3a81e6bd6ab42955e8823c1f625b3 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sun, 18 Jan 2026 17:46:46 -0600
Subject: [PATCH 10/32] Implement rank-1 array variables
---
flang/lib/Semantics/expression.cpp | 96 ++++++++++++++++++++++++++----
1 file changed, 85 insertions(+), 11 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8c3e9810a2ec2..a4f2828bbefbc 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4399,11 +4399,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
for (const auto &acValue : acSpec.values) {
if (const auto *indirExpr =
std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
-
- // Create new BoundExpr wrapping a reference to the expression
- // Don't copy - use the existing indirection
- parser::BoundExpr newBoundExpr{
- parser::Integer(std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
+ parser::BoundExpr newBoundExpr{parser::Integer(
+ std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
// Create new AllocateShapeSpec with optional lower bound and upper bound
parser::AllocateShapeSpec newSpec =
@@ -4419,13 +4416,90 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
mutableShapeSpecList.clear();
mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
+ }
+ else if(const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
+ // Handle Designator case: allocate(array(dims)) where dims is a variable
+ if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
+ if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
+ // It's a simple name reference like 'dims'
+ if (const Symbol *symbol{name->symbol}) {
+ int varRank{symbol->Rank()};
+ // Only expand if it's a 1D array (dims is rank-1)
+ if (varRank == 1) {
+ std::list<parser::AllocateShapeSpec> newShapeSpecs;
+ // Get the size of the dims array from its type
+ if (const auto shape{GetShape(foldingContext_, *symbol)}) {
+ if (auto dimSize{ToInt64(shape->at(0))}) {
+ for (std::int64_t i = 0; i < *dimSize; ++i) {
+ // Get lower bound of dims array (dimension 0)
+ auto lowerBound{GetLBOUND(foldingContext_, NamedEntity{*symbol}, 0)};
+ auto lb{ToInt64(lowerBound)};
+ std::int64_t subscriptIndex = (lb ? *lb : 1) + i;
+
+ // Create static string representations of subscript indices
+ static const char* subscriptStrings[] = {"1", "2", "3", "4", "5", "6", "7", "8", "9"};
+ const char* subscriptStr = (subscriptIndex <= 9) ? subscriptStrings[subscriptIndex-1] : "?";
+
+ // Create the integer subscript expression: dims(i)
+ auto literalInt = parser::IntLiteralConstant{
+ parser::CharBlock{subscriptStr, 1},
+ std::optional<parser::KindParam>{}
+ };
+
+ auto subscriptExpr = common::Indirection<parser::Expr>{
+ parser::Expr{
+ parser::LiteralConstant{std::move(literalInt)}
+ }
+ };
+
+ // Create subscript list: [dims(i)]
+ std::list<parser::SectionSubscript> subscripts;
+ subscripts.emplace_back(parser::IntExpr{std::move(subscriptExpr)});
+
+ // Create PartRef with the name and subscripts - move the Name
+ std::list<parser::PartRef> partRefs;
+ partRefs.emplace_back(
+ std::move(const_cast<parser::Name&>(*name)),
+ std::move(subscripts),
+ std::optional<parser::ImageSelector>{}
+ );
+
+ // Create DataRef from the PartRef
+ parser::DataRef dataRef{std::move(partRefs)};
+
+ // Create the full designator: dims(i)
+ auto dimDesignator = parser::Designator{std::move(dataRef)};
+ auto dimExpr = common::Indirection<parser::Expr>{
+ parser::Expr{std::move(dimDesignator)}
+ };
+
+ // Create BoundExpr wrapping the subscripted reference
+ parser::BoundExpr newBoundExpr{parser::Integer{std::move(dimExpr)}};
+
+ // Create AllocateShapeSpec
+ parser::AllocateShapeSpec newSpec =
+ std::make_tuple(std::optional<parser::BoundExpr>{}, std::move(newBoundExpr));
+
+ newShapeSpecs.push_back(std::move(newSpec));
+ }
- // printf("printing tree from allocation_ node\n");
-
- // std::string buf;
- // llvm::raw_string_ostream dump{buf};
- // Fortran::parser::DumpTree(dump, x);
- // std::cout << buf << std::endl;
+ // Replace the original list with expanded specs
+ auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
+ mutableShapeSpecList.clear();
+ mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
+
+ // printf("printing tree from allocation_ node after dims expansion\n");
+ // std::string buf;
+ // llvm::raw_string_ostream dump{buf};
+ // Fortran::parser::DumpTree(dump, x);
+ // std::cout << buf << std::endl;
+ }
+ }
+ }
+ }
+ }
+ }
}
return std::nullopt;
}
>From 9ada24a23450c9e9c13d597376052bd987b5b4e2 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 20 Jan 2026 16:38:05 -0600
Subject: [PATCH 11/32] Implement broadcasting a scalar to an array for integer
literal scalar and array literal for the array. TODO: Generalize selection
logic, get rid of redundant code, allow mixing of array/scalar literal with
variable.
---
flang/lib/Semantics/expression.cpp | 57 +++++++++++++++++++++++++++---
1 file changed, 52 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index a4f2828bbefbc..e02372f47a51b 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4387,29 +4387,76 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
}
const auto &shapeSpec{shapeSpecList.front()};
+ const auto &lowerBoundOpt = std::get<0>(shapeSpec.t);
auto &expr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
if (const auto *arrayConstructor{
std::get_if<parser::ArrayConstructor>(&expr.u)}) {
const auto &acSpec{arrayConstructor->v}; // AcSpec
- std::list<parser::AllocateShapeSpec> newShapeSpecs;
+ std::vector<std::optional<parser::BoundExpr>> lowerBoundExprs;
+ // assume array literal for now
+ if(lowerBoundOpt) {
+ auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ if(const auto *arrayConstructorLower{
+ std::get_if<parser::ArrayConstructor>(&exprLower.u)
+ }) {
+ const auto &acSpecLower{arrayConstructorLower->v}; // AcSpec
+ for(const auto &acValueLower : acSpecLower.values) {
+ if (const auto *indirExprLower =
+ std::get_if<common::Indirection<parser::Expr>>(&acValueLower.u)) {
+ parser::BoundExpr lowerBoundExpr{parser::Integer(
+ std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExprLower)))};
+ lowerBoundExprs.push_back(std::move(lowerBoundExpr));
+ }
+ }
+ }
+ else if(const auto *literalConst{
+ std::get_if<parser::LiteralConstant>(&exprLower.u)
+ }) {
+ if(const auto *intConst{
+ std::get_if<parser::IntLiteralConstant>(&literalConst->u)
+ }) {
+ // We found a scalar integer literal
+ // Duplicate it for each dimension
+ for(size_t i = 0; i < acSpec.values.size(); i++) {
+ parser::BoundExpr boundExpr{parser::Integer(
+ common::Indirection<parser::Expr>{
+ parser::Expr{std::move(const_cast<parser::LiteralConstant&>(*literalConst))}
+ })};
+ lowerBoundExprs.push_back(std::move(boundExpr));
+ }
+ }
+ }
+ }
+ else {
+ // fill lowerBoundExprs with empty opt,
+ // std::optional<parser::BoundExpr>{},
+ for(size_t i = 0; i < acSpec.values.size(); i++) {
+ lowerBoundExprs.push_back(std::optional<parser::BoundExpr>{});
+ }
+ }
// Iterate through array constructor values
+ std::vector<parser::BoundExpr> newBoundExprs;
for (const auto &acValue : acSpec.values) {
if (const auto *indirExpr =
std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
parser::BoundExpr newBoundExpr{parser::Integer(
std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
-
+ newBoundExprs.push_back(std::move(newBoundExpr));
+ }
+ }
+
+ std::list<parser::AllocateShapeSpec> newShapeSpecs;
+ for(int i = 0; i < acSpec.values.size(); i++) {
// Create new AllocateShapeSpec with optional lower bound and upper bound
parser::AllocateShapeSpec newSpec =
std::make_tuple(
- std::optional<parser::BoundExpr>{},
- std::move(newBoundExpr));
+ std::move(lowerBoundExprs[i]),
+ std::move(newBoundExprs[i]));
newShapeSpecs.push_back(std::move(newSpec));
- }
}
// Replace the original list with expanded specs
>From cd86bfa3aecde2a5c297b8794a607bb01f631999 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 21 Jan 2026 18:04:17 -0600
Subject: [PATCH 12/32] Refactored to have all functionality dispatched on
types. TODO: Fix broadcast when used a variable instead of int literal. TODO:
Error handling
---
flang/lib/Semantics/expression.cpp | 209 ++++++++++++++++++++++++++++-
1 file changed, 205 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e02372f47a51b..5174e911d86cc 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4377,17 +4377,218 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
return ExprOrVariable(x, parser::FindSourceLocation(x));
}
-MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
+static bool isRank1Array(const parser::Expr& expr) {
+ if(std::get_if<parser::ArrayConstructor>(&expr.u)) {
+ return true;
+ }
+ else if(const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
+ if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
+ if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
+ if (const Symbol *symbol{name->symbol}) {
+ int varRank{symbol->Rank()};
+ if (varRank == 1) {
+ return true;
+ }
+ }
+ }
+ }
+ }
+ return false;
+}
+
+// returns 0, 1, or 2
+static int countRank1Arrays(const parser::Allocation &x) {
+ int result = 0;
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(
(std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
-
- if (shapeSpecList.empty()) {
- return std::nullopt;
+ const auto &shapeSpec{shapeSpecList.front()};
+
+ const auto &upperExpr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
+ if(isRank1Array(upperExpr)) {
+ result++;
+ }
+ const auto &lowerBoundOpt = std::get<0>(shapeSpec.t);
+ if(lowerBoundOpt) {
+ const auto &upperExpr = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ if(isRank1Array(upperExpr)) {
+ result++;
+ }
+ }
+ return result;
+}
+
+static void scalarToBoundExprs(std::vector<parser::BoundExpr>& exprsList, const parser::Expr& scalarInt, int count) {
+ if(const auto *literalConst{
+ std::get_if<parser::LiteralConstant>(&scalarInt.u) }) {
+ if(const auto *intConst{
+ std::get_if<parser::IntLiteralConstant>(&literalConst->u)}) {
+ for(size_t i = 0; i < count; i++) {
+ parser::BoundExpr boundExpr{parser::Integer(
+ common::Indirection<parser::Expr>{
+ parser::Expr{std::move(const_cast<parser::LiteralConstant&>(*literalConst))}
+ })};
+ exprsList.push_back(std::move(boundExpr));
+ }
+ }
}
+}
+// handles both ArrayConstructor and Designator
+static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_, std::vector<parser::BoundExpr>& exprsList, const parser::Expr& designatorOrArrayCtrExpr) {
+ if (const auto *arrayConstructor{
+ std::get_if<parser::ArrayConstructor>(&designatorOrArrayCtrExpr.u)}) {
+ const auto &acSpec{arrayConstructor->v}; // AcSpec
+ for (const auto &acValue : acSpec.values) {
+ if (const auto *indirExpr =
+ std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
+ parser::BoundExpr newBoundExpr{parser::Integer(
+ std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
+ exprsList.push_back(std::move(newBoundExpr));
+ }
+ }
+ }
+ else if(const auto *designator{
+ std::get_if<common::Indirection<parser::Designator>>(&designatorOrArrayCtrExpr.u)}) {
+ // Handle Designator case: allocate(array(dims)) where dims is a variable
+ if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
+ if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
+ // It's a simple name reference like 'dims'
+ if (const Symbol *symbol{name->symbol}) {
+ int varRank{symbol->Rank()};
+ // Only expand if it's a 1D array (dims is rank-1)
+ if (varRank == 1) {
+ // Get the size of the dims array from its type
+ if (const auto shape{GetShape(foldingContext_, *symbol)}) {
+ if (auto dimSize{ToInt64(shape->at(0))}) {
+ for (std::int64_t i = 0; i < *dimSize; ++i) {
+ // Get lower bound of dims array (dimension 0)
+ auto lowerBound{GetLBOUND(foldingContext_, NamedEntity{*symbol}, 0)};
+ auto lb{ToInt64(lowerBound)};
+ std::int64_t subscriptIndex = (lb ? *lb : 1) + i;
+
+ static const char* subscriptStrings[] = {"1", "2", "3", "4", "5", "6", "7", "8", "9"};
+ const char* subscriptStr = (subscriptIndex <= 9) ? subscriptStrings[subscriptIndex-1] : "?";
+
+ // Create the integer subscript expression: dims(i)
+ auto literalInt = parser::IntLiteralConstant{
+ parser::CharBlock{subscriptStr, 1},
+ std::optional<parser::KindParam>{}
+ };
+
+ auto subscriptExpr = common::Indirection<parser::Expr>{
+ parser::Expr{
+ parser::LiteralConstant{std::move(literalInt)}
+ }
+ };
+
+ // Create subscript list: [dims(i)]
+ std::list<parser::SectionSubscript> subscripts;
+ subscripts.emplace_back(parser::IntExpr{std::move(subscriptExpr)});
+
+ // Create PartRef with the name and subscripts - move the Name
+ std::list<parser::PartRef> partRefs;
+ partRefs.emplace_back(
+ std::move(const_cast<parser::Name&>(*name)),
+ std::move(subscripts),
+ std::optional<parser::ImageSelector>{}
+ );
+
+ // Create DataRef from the PartRef
+ parser::DataRef dataRef{std::move(partRefs)};
+
+ // Create the full designator: dims(i)
+ auto dimDesignator = parser::Designator{std::move(dataRef)};
+ auto dimExpr = common::Indirection<parser::Expr>{
+ parser::Expr{std::move(dimDesignator)}
+ };
+
+ // Create BoundExpr wrapping the subscripted reference
+ parser::BoundExpr newBoundExpr{parser::Integer{std::move(dimExpr)}};
+ exprsList.push_back(std::move(newBoundExpr));
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ }
+ return;
+}
+
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
+ const int rank1Arrays = countRank1Arrays(x);
+ if(rank1Arrays == 0) {
+ printf("Early return bc rank1Arrays == 0\n");
+ return std::nullopt;
+ }
+ else {
+ printf("No early return bc rank1Arrays != 0\n");
+ }
+ auto &shapeSpecList{
+ std::get<std::list<parser::AllocateShapeSpec>>(
+ (std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
const auto &shapeSpec{shapeSpecList.front()};
const auto &lowerBoundOpt = std::get<0>(shapeSpec.t);
+
+ std::vector<std::optional<parser::BoundExpr>> lowerBoundOptExprs;
+ std::vector<parser::BoundExpr> lowerBoundExprs;
+ std::vector<parser::BoundExpr> upperBoundExprs;
+ // only upper bound was provided, and rank1Arrays is not 0, so
+ // it must be a rank-1 integer array (and rank1Arrays == 1)
+ if(!lowerBoundOpt) {
+ const auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
+ rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
+ // fill lowerBoundOptExprs with empty optional, same size as upperBoundExprs
+ for(size_t i = 0; i < upperBoundExprs.size(); i++) {
+ lowerBoundOptExprs.push_back(std::optional<parser::BoundExpr>{});
+ }
+ }
+ else if (rank1Arrays == 1) { // && lowerBoundOpt
+ // we don't know which one is the intArray and which is the scalar integer.
+ // since we know we have rank1Arrays == 1, we only need to check one type
+ // to determine everything
+ auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
+ if(isRank1Array(exprLower)) { // exprLower is array, exprUpper is scalar
+ rank1IntArrayToBoundExprs(foldingContext_, lowerBoundExprs, exprLower);
+ scalarToBoundExprs(upperBoundExprs, exprUpper, lowerBoundExprs.size());
+ }
+ else { //exprLower is scalar, exprUpper is array
+ rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
+ scalarToBoundExprs(lowerBoundExprs, exprLower, upperBoundExprs.size());
+ }
+ for(size_t i = 0; i < lowerBoundExprs.size(); i++) {
+ lowerBoundOptExprs.push_back(std::move(lowerBoundExprs[i]));
+ }
+ }
+ else { // both are arrays
+ auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
+ rank1IntArrayToBoundExprs(foldingContext_, lowerBoundExprs, exprLower);
+ rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
+ for(size_t i = 0; i < lowerBoundExprs.size(); i++) {
+ lowerBoundOptExprs.push_back(std::move(lowerBoundExprs[i]));
+ }
+ }
+ std::list<parser::AllocateShapeSpec> newShapeSpecs;
+ for(int i = 0; i < upperBoundExprs.size(); i++) {
+ // Create new AllocateShapeSpec with optional lower bound and upper bound
+ parser::AllocateShapeSpec newSpec =
+ std::make_tuple(
+ std::move(lowerBoundOptExprs[i]),
+ std::move(upperBoundExprs[i]));
+ newShapeSpecs.push_back(std::move(newSpec));
+ }
+ // Replace the original list with expanded specs
+ auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
+ mutableShapeSpecList.clear();
+ mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
+ return std::nullopt;
+
+
auto &expr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
if (const auto *arrayConstructor{
>From 65d86e111e85ce1aea24994e9e0041cbb86eecc6 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Thu, 22 Jan 2026 20:10:58 -0600
Subject: [PATCH 13/32] Fix compile error, delete unreachable code
---
flang/lib/Semantics/expression.cpp | 170 +----------------------------
1 file changed, 2 insertions(+), 168 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 5174e911d86cc..644e0b7853492 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4440,7 +4440,8 @@ static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_,
if (const auto *arrayConstructor{
std::get_if<parser::ArrayConstructor>(&designatorOrArrayCtrExpr.u)}) {
const auto &acSpec{arrayConstructor->v}; // AcSpec
- for (const auto &acValue : acSpec.values) {
+ const auto &acValues{std::get<1>(acSpec.t)}; // Get the list of values
+ for (const auto &acValue : acValues) {
if (const auto *indirExpr =
std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
parser::BoundExpr newBoundExpr{parser::Integer(
@@ -4521,12 +4522,8 @@ static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_,
MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
const int rank1Arrays = countRank1Arrays(x);
if(rank1Arrays == 0) {
- printf("Early return bc rank1Arrays == 0\n");
return std::nullopt;
}
- else {
- printf("No early return bc rank1Arrays != 0\n");
- }
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(
(std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
@@ -4587,169 +4584,6 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
mutableShapeSpecList.clear();
mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
return std::nullopt;
-
-
- auto &expr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
-
- if (const auto *arrayConstructor{
- std::get_if<parser::ArrayConstructor>(&expr.u)}) {
-
- const auto &acSpec{arrayConstructor->v}; // AcSpec
- std::vector<std::optional<parser::BoundExpr>> lowerBoundExprs;
- // assume array literal for now
- if(lowerBoundOpt) {
- auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
- if(const auto *arrayConstructorLower{
- std::get_if<parser::ArrayConstructor>(&exprLower.u)
- }) {
- const auto &acSpecLower{arrayConstructorLower->v}; // AcSpec
- for(const auto &acValueLower : acSpecLower.values) {
- if (const auto *indirExprLower =
- std::get_if<common::Indirection<parser::Expr>>(&acValueLower.u)) {
- parser::BoundExpr lowerBoundExpr{parser::Integer(
- std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExprLower)))};
- lowerBoundExprs.push_back(std::move(lowerBoundExpr));
- }
- }
- }
- else if(const auto *literalConst{
- std::get_if<parser::LiteralConstant>(&exprLower.u)
- }) {
- if(const auto *intConst{
- std::get_if<parser::IntLiteralConstant>(&literalConst->u)
- }) {
- // We found a scalar integer literal
- // Duplicate it for each dimension
- for(size_t i = 0; i < acSpec.values.size(); i++) {
- parser::BoundExpr boundExpr{parser::Integer(
- common::Indirection<parser::Expr>{
- parser::Expr{std::move(const_cast<parser::LiteralConstant&>(*literalConst))}
- })};
- lowerBoundExprs.push_back(std::move(boundExpr));
- }
- }
- }
- }
- else {
- // fill lowerBoundExprs with empty opt,
- // std::optional<parser::BoundExpr>{},
- for(size_t i = 0; i < acSpec.values.size(); i++) {
- lowerBoundExprs.push_back(std::optional<parser::BoundExpr>{});
- }
- }
-
- // Iterate through array constructor values
- std::vector<parser::BoundExpr> newBoundExprs;
- for (const auto &acValue : acSpec.values) {
- if (const auto *indirExpr =
- std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
- parser::BoundExpr newBoundExpr{parser::Integer(
- std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
- newBoundExprs.push_back(std::move(newBoundExpr));
- }
- }
-
- std::list<parser::AllocateShapeSpec> newShapeSpecs;
- for(int i = 0; i < acSpec.values.size(); i++) {
- // Create new AllocateShapeSpec with optional lower bound and upper bound
- parser::AllocateShapeSpec newSpec =
- std::make_tuple(
- std::move(lowerBoundExprs[i]),
- std::move(newBoundExprs[i]));
-
- newShapeSpecs.push_back(std::move(newSpec));
- }
-
- // Replace the original list with expanded specs
- auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
- mutableShapeSpecList.clear();
- mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
- }
- else if(const auto *designator{
- std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
- // Handle Designator case: allocate(array(dims)) where dims is a variable
- if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
- if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
- // It's a simple name reference like 'dims'
- if (const Symbol *symbol{name->symbol}) {
- int varRank{symbol->Rank()};
- // Only expand if it's a 1D array (dims is rank-1)
- if (varRank == 1) {
- std::list<parser::AllocateShapeSpec> newShapeSpecs;
- // Get the size of the dims array from its type
- if (const auto shape{GetShape(foldingContext_, *symbol)}) {
- if (auto dimSize{ToInt64(shape->at(0))}) {
- for (std::int64_t i = 0; i < *dimSize; ++i) {
- // Get lower bound of dims array (dimension 0)
- auto lowerBound{GetLBOUND(foldingContext_, NamedEntity{*symbol}, 0)};
- auto lb{ToInt64(lowerBound)};
- std::int64_t subscriptIndex = (lb ? *lb : 1) + i;
-
- // Create static string representations of subscript indices
- static const char* subscriptStrings[] = {"1", "2", "3", "4", "5", "6", "7", "8", "9"};
- const char* subscriptStr = (subscriptIndex <= 9) ? subscriptStrings[subscriptIndex-1] : "?";
-
- // Create the integer subscript expression: dims(i)
- auto literalInt = parser::IntLiteralConstant{
- parser::CharBlock{subscriptStr, 1},
- std::optional<parser::KindParam>{}
- };
-
- auto subscriptExpr = common::Indirection<parser::Expr>{
- parser::Expr{
- parser::LiteralConstant{std::move(literalInt)}
- }
- };
-
- // Create subscript list: [dims(i)]
- std::list<parser::SectionSubscript> subscripts;
- subscripts.emplace_back(parser::IntExpr{std::move(subscriptExpr)});
-
- // Create PartRef with the name and subscripts - move the Name
- std::list<parser::PartRef> partRefs;
- partRefs.emplace_back(
- std::move(const_cast<parser::Name&>(*name)),
- std::move(subscripts),
- std::optional<parser::ImageSelector>{}
- );
-
- // Create DataRef from the PartRef
- parser::DataRef dataRef{std::move(partRefs)};
-
- // Create the full designator: dims(i)
- auto dimDesignator = parser::Designator{std::move(dataRef)};
- auto dimExpr = common::Indirection<parser::Expr>{
- parser::Expr{std::move(dimDesignator)}
- };
-
- // Create BoundExpr wrapping the subscripted reference
- parser::BoundExpr newBoundExpr{parser::Integer{std::move(dimExpr)}};
-
- // Create AllocateShapeSpec
- parser::AllocateShapeSpec newSpec =
- std::make_tuple(std::optional<parser::BoundExpr>{}, std::move(newBoundExpr));
-
- newShapeSpecs.push_back(std::move(newSpec));
- }
-
- // Replace the original list with expanded specs
- auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
- mutableShapeSpecList.clear();
- mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
-
- // printf("printing tree from allocation_ node after dims expansion\n");
- // std::string buf;
- // llvm::raw_string_ostream dump{buf};
- // Fortran::parser::DumpTree(dump, x);
- // std::cout << buf << std::endl;
- }
- }
- }
- }
- }
- }
- }
- return std::nullopt;
}
Expr<SubscriptInteger> ExpressionAnalyzer::AnalyzeKindSelector(
>From c206443d8f971d74ee6e2ede1ccf919a1afbacaa Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Sat, 24 Jan 2026 15:54:23 -0600
Subject: [PATCH 14/32] Move analysis from Allocation to
AllocateShapeSpecArrayList. Essentially, all this does is fix a misparse by
changing the active member in the variant. Since we cannot rewrite the tree
by cloning existing nodes, the broadcast scalar to an array case is
unimplementable for rank > 1. We instead handle rank-1 arrays in Lower
instead of massaging into AllocateShapeSpec's in the parse tree. Guard all
uses of ShapeSpecList in check-allocate.cpp and Allocatable.cpp so I can
implement the Array case, and mark TODO codegen which coincide with the uses
of getShapeSpecs.
---
flang/include/flang/Semantics/expression.h | 6 +-
flang/lib/Lower/Allocatable.cpp | 149 ++++++++++++---------
flang/lib/Semantics/check-allocate.cpp | 146 +++++++++++---------
flang/lib/Semantics/expression.cpp | 148 +++++++++++---------
4 files changed, 260 insertions(+), 189 deletions(-)
diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index 37e1f25b0fd1b..a10613ca0b5a4 100644
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -251,7 +251,7 @@ class ExpressionAnalyzer {
MaybeExpr Analyze(const parser::InitialDataTarget &);
MaybeExpr Analyze(const parser::NullInit &);
MaybeExpr Analyze(const parser::StmtFunctionStmt &);
- MaybeExpr Analyze(const parser::Allocation &);
+ MaybeExpr Analyze(const parser::AllocateShapeSpecArrayList &x);
void Analyze(const parser::CallStmt &);
const Assignment *Analyze(const parser::AssignmentStmt &);
@@ -504,9 +504,9 @@ class ExprChecker {
AnalyzeAndNoteUses(x, /*isDefinition=*/true);
return false;
}
- bool Pre(const parser::Allocation &x) {
+ bool Pre(const parser::AllocateShapeSpecArrayList &x) {
exprAnalyzer_.Analyze(x);
- return true;
+ return false;
}
bool Pre(const parser::DataStmtObject &);
void Post(const parser::DataStmtObject &);
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index a46dc0f3da9d7..bcfc4fcd18b5f 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -336,9 +336,18 @@ class AllocateStmtHelper {
const Fortran::semantics::Symbol &getSymbol() const {
return unwrapSymbol(getAllocObj());
}
+ // Check if this allocation uses array bounds (F2023 feature)
+ bool hasArrayBounds() const {
+ const auto &shapeSpecArrayList{
+ std::get<Fortran::parser::AllocateShapeSpecArrayList>(alloc.t)};
+ return std::holds_alternative<Fortran::parser::AllocateShapeSpecArray>(
+ shapeSpecArrayList.u);
+ }
const std::list<Fortran::parser::AllocateShapeSpec> &getShapeSpecs() const {
return std::get<std::list<Fortran::parser::AllocateShapeSpec>>((std::get<Fortran::parser::AllocateShapeSpecArrayList>(alloc.t)).u);
- // return std::get<std::list<Fortran::parser::AllocateShapeSpec>>(alloc.t);
+ }
+ const Fortran::parser::AllocateShapeSpecArray &getShapeSpecArrays() const {
+ return std::get<Fortran::parser::AllocateShapeSpecArray>((std::get<Fortran::parser::AllocateShapeSpecArrayList>(alloc.t)).u);
}
};
@@ -395,11 +404,17 @@ class AllocateStmtHelper {
}
static bool lowerBoundsAreOnes(const Allocation &alloc) {
- for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
- alloc.getShapeSpecs())
- if (std::get<0>(shapeSpec.t))
- return false;
- return true;
+ if(!alloc.hasArrayBounds()) {
+ for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
+ alloc.getShapeSpecs())
+ if (std::get<0>(shapeSpec.t))
+ return false;
+ return true;
+ }
+ else {
+ printf("UNIMPLEMENTED 1, hardcoding true for my case which doesn't use lower bounds\n");
+ return true;
+ }
}
/// Build name for the fir::allocmem generated for alloc.
@@ -417,31 +432,38 @@ class AllocateStmtHelper {
mlir::Type idxTy = builder.getIndexType();
bool lBoundsAreOnes = lowerBoundsAreOnes(alloc);
mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
- for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
- alloc.getShapeSpecs()) {
- mlir::Value lb;
- if (!lBoundsAreOnes) {
- if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
- std::get<0>(shapeSpec.t)) {
- lb = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
- lb = builder.createConvert(loc, idxTy, lb);
+ if(!alloc.hasArrayBounds()) {
+ for (const Fortran::parser::AllocateShapeSpec &shapeSpec :
+ alloc.getShapeSpecs()) {
+ mlir::Value lb;
+ if (!lBoundsAreOnes) {
+ if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
+ std::get<0>(shapeSpec.t)) {
+ lb = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
+ lb = builder.createConvert(loc, idxTy, lb);
+ } else {
+ lb = one;
+ }
+ lbounds.emplace_back(lb);
+ }
+ mlir::Value ub = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx));
+ ub = builder.createConvert(loc, idxTy, ub);
+ if (lb) {
+ mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
+ extents.emplace_back(
+ mlir::arith::AddIOp::create(builder, loc, diff, one));
} else {
- lb = one;
+ extents.emplace_back(ub);
}
- lbounds.emplace_back(lb);
- }
- mlir::Value ub = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(std::get<1>(shapeSpec.t)), stmtCtx));
- ub = builder.createConvert(loc, idxTy, ub);
- if (lb) {
- mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
- extents.emplace_back(
- mlir::arith::AddIOp::create(builder, loc, diff, one));
- } else {
- extents.emplace_back(ub);
}
}
+ else {
+ printf("IMPLEMENTING 2\n");
+ const auto &array{alloc.getShapeSpecArrays()};
+
+ }
fir::factory::genInlinedAllocation(builder, loc, box, lbounds, extents,
lenParams, mangleAlloc(alloc),
/*mustBeHeap=*/true);
@@ -587,42 +609,47 @@ class AllocateStmtHelper {
mlir::Type idxTy = builder.getIndexType();
mlir::Type i32Ty = builder.getIntegerType(32);
Fortran::lower::StatementContext stmtCtx;
- for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
- mlir::Value lb;
- const auto &bounds = iter.value().t;
- if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
- std::get<0>(bounds))
- lb = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
- else
- lb = builder.createIntegerConstant(loc, idxTy, 1);
- mlir::Value ub = fir::getBase(converter.genExprValue(
- loc, Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx));
- mlir::Value dimIndex =
- builder.createIntegerConstant(loc, i32Ty, iter.index());
- // Runtime call
- genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
- }
- if (sourceExpr && sourceExpr->Rank() > 0 &&
- alloc.getShapeSpecs().size() == 0) {
- // If the alloc object does not have shape list, get the bounds from the
- // source expression.
- mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
- const auto *sourceBox = sourceExv.getBoxOf<fir::BoxValue>();
- assert(sourceBox && "source expression should be lowered to one box");
- for (int i = 0; i < sourceExpr->Rank(); ++i) {
- auto dimVal = builder.createIntegerConstant(loc, idxTy, i);
- auto dimInfo = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,
- sourceBox->getAddr(), dimVal);
- mlir::Value lb =
- fir::factory::readLowerBound(builder, loc, sourceExv, i, one);
- mlir::Value extent = dimInfo.getResult(1);
- mlir::Value ub = mlir::arith::SubIOp::create(
- builder, loc, mlir::arith::AddIOp::create(builder, loc, extent, lb),
- one);
- mlir::Value dimIndex = builder.createIntegerConstant(loc, i32Ty, i);
+ if(!alloc.hasArrayBounds()) {
+ for (const auto &iter : llvm::enumerate(alloc.getShapeSpecs())) {
+ mlir::Value lb;
+ const auto &bounds = iter.value().t;
+ if (const std::optional<Fortran::parser::BoundExpr> &lbExpr =
+ std::get<0>(bounds))
+ lb = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(*lbExpr), stmtCtx));
+ else
+ lb = builder.createIntegerConstant(loc, idxTy, 1);
+ mlir::Value ub = fir::getBase(converter.genExprValue(
+ loc, Fortran::semantics::GetExpr(std::get<1>(bounds)), stmtCtx));
+ mlir::Value dimIndex =
+ builder.createIntegerConstant(loc, i32Ty, iter.index());
+ // Runtime call
genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
}
+ if (sourceExpr && sourceExpr->Rank() > 0 &&
+ alloc.getShapeSpecs().size() == 0) {
+ // If the alloc object does not have shape list, get the bounds from the
+ // source expression.
+ mlir::Value one = builder.createIntegerConstant(loc, idxTy, 1);
+ const auto *sourceBox = sourceExv.getBoxOf<fir::BoxValue>();
+ assert(sourceBox && "source expression should be lowered to one box");
+ for (int i = 0; i < sourceExpr->Rank(); ++i) {
+ auto dimVal = builder.createIntegerConstant(loc, idxTy, i);
+ auto dimInfo = fir::BoxDimsOp::create(builder, loc, idxTy, idxTy, idxTy,
+ sourceBox->getAddr(), dimVal);
+ mlir::Value lb =
+ fir::factory::readLowerBound(builder, loc, sourceExv, i, one);
+ mlir::Value extent = dimInfo.getResult(1);
+ mlir::Value ub = mlir::arith::SubIOp::create(
+ builder, loc, mlir::arith::AddIOp::create(builder, loc, extent, lb),
+ one);
+ mlir::Value dimIndex = builder.createIntegerConstant(loc, i32Ty, i);
+ genRuntimeSetBounds(builder, loc, box, dimIndex, lb, ub);
+ }
+ }
+ }
+ else {
+ printf("UNIMPLEMENTED 3\n");
}
}
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 5d2015b87d378..ae797689bd783 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -47,6 +47,7 @@ class AllocationCheckerHelper {
const parser::Allocation &alloc, AllocateCheckerInfo &info)
: allocateInfo_{info}, allocation_{alloc},
allocateObject_{std::get<parser::AllocateObject>(alloc.t)},
+ isArray{IsArray(alloc)},
allocateShapeSpecRank_{ShapeSpecRank(alloc)},
allocateCoarraySpecRank_{CoarraySpecRank(alloc)} {}
@@ -57,7 +58,17 @@ class AllocationCheckerHelper {
bool hasAllocateCoarraySpec() const { return allocateCoarraySpecRank_ != 0; }
bool RunCoarrayRelatedChecks(SemanticsContext &) const;
- static int ShapeSpecRank(const parser::Allocation &allocation) {
+ static bool IsArray(const parser::Allocation &allocation) {
+ // At this point, tree should be rewritten, so we can query
+ // the active variant in AllocationShapeSpecArrayList
+ const auto &allocateShapeSpecArrayList{std::get<parser::AllocateShapeSpecArrayList>(allocation.t)};
+ return std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u);
+ }
+
+ int ShapeSpecRank(const parser::Allocation &allocation) {
+ if(isArray) {
+ return 0;
+ }
return static_cast<int>(
std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation.t)).u).size());
}
@@ -91,6 +102,7 @@ class AllocationCheckerHelper {
AllocateCheckerInfo &allocateInfo_;
const parser::Allocation &allocation_;
const parser::AllocateObject &allocateObject_;
+ const bool isArray{false};
const int allocateShapeSpecRank_{0};
const int allocateCoarraySpecRank_{0};
const parser::Name &name_{parser::GetLastName(allocateObject_)};
@@ -580,79 +592,85 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
return false;
}
if (rank_ > 0) {
- if (!hasAllocateShapeSpecList()) {
- // C939
- if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
- context.Say(name_.source,
- "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US);
- return false;
- } else {
- if (allocateInfo_.sourceExprRank != rank_) {
- context
- .Say(name_.source,
- "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US)
- .Attach(allocateInfo_.sourceExprLoc.value(),
- "Expression in %s has rank %d but allocatable object has rank %d"_en_US,
- allocateInfo_.gotSource ? "SOURCE" : "MOLD",
- allocateInfo_.sourceExprRank, rank_);
+ if(!isArray) {
+ if (!hasAllocateShapeSpecList()) {
+ // C939
+ if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
+ context.Say(name_.source,
+ "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US);
return false;
+ } else {
+ if (allocateInfo_.sourceExprRank != rank_) {
+ context
+ .Say(name_.source,
+ "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US)
+ .Attach(allocateInfo_.sourceExprLoc.value(),
+ "Expression in %s has rank %d but allocatable object has rank %d"_en_US,
+ allocateInfo_.gotSource ? "SOURCE" : "MOLD",
+ allocateInfo_.sourceExprRank, rank_);
+ return false;
+ }
}
}
} else {
// explicit shape-spec-list
- if (allocateShapeSpecRank_ != rank_) {
- context
- .Say(name_.source,
- "The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
- .Attach(
- ultimate_->name(), "Declared here with rank %d"_en_US, rank_);
- return false;
- } else if (allocateInfo_.gotSource && allocateInfo_.sourceExprShape &&
- allocateInfo_.sourceExprShape->size() ==
- static_cast<std::size_t>(allocateShapeSpecRank_)) {
- std::size_t j{0};
- for (const auto &shapeSpec :
- std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)).u)) {
- if (j >= allocateInfo_.sourceExprShape->size()) {
- break;
- }
- std::optional<evaluate::ConstantSubscript> lbound;
- if (const auto &lb{std::get<0>(shapeSpec.t)}) {
- lbound.reset();
- const auto &lbExpr{parser::UnwrapRef<parser::Expr>(lb)};
- if (const auto *expr{GetExpr(context, lbExpr)}) {
- auto folded{
- evaluate::Fold(context.foldingContext(), SomeExpr(*expr))};
- lbound = evaluate::ToInt64(folded);
- evaluate::SetExpr(lbExpr, std::move(folded));
+ if (!isArray) {
+ if (allocateShapeSpecRank_ != rank_) {
+ printf("%d != %d\n", allocateShapeSpecRank_, rank_);
+ context
+ .Say(name_.source,
+ "The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
+ .Attach(
+ ultimate_->name(), "Declared here with rank %d"_en_US, rank_);
+ return false;
+ } else if (allocateInfo_.gotSource && allocateInfo_.sourceExprShape &&
+ allocateInfo_.sourceExprShape->size() ==
+ static_cast<std::size_t>(allocateShapeSpecRank_)) {
+ std::size_t j{0};
+ printf("bool AllocationCheckerHelper::RunChecks in Semantics/check-allocate.cpp\n");
+ for (const auto &shapeSpec :
+ std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)).u)) {
+ if (j >= allocateInfo_.sourceExprShape->size()) {
+ break;
}
- } else {
- lbound = 1;
- }
- if (lbound) {
- const auto &ubExpr{
- parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t))};
- if (const auto *expr{GetExpr(context, ubExpr)}) {
- auto folded{
- evaluate::Fold(context.foldingContext(), SomeExpr(*expr))};
- auto ubound{evaluate::ToInt64(folded)};
- evaluate::SetExpr(ubExpr, std::move(folded));
- if (ubound) {
- auto extent{*ubound - *lbound + 1};
- if (extent < 0) {
- extent = 0;
- }
- if (extent != allocateInfo_.sourceExprShape->at(j)) {
- context.Say(name_.source,
- "Allocation has extent %jd on dimension %d, but SOURCE= has extent %jd"_err_en_US,
- static_cast<std::intmax_t>(extent), j + 1,
- static_cast<std::intmax_t>(
- allocateInfo_.sourceExprShape->at(j)));
+ std::optional<evaluate::ConstantSubscript> lbound;
+ if (const auto &lb{std::get<0>(shapeSpec.t)}) {
+ lbound.reset();
+ const auto &lbExpr{parser::UnwrapRef<parser::Expr>(lb)};
+ if (const auto *expr{GetExpr(context, lbExpr)}) {
+ auto folded{
+ evaluate::Fold(context.foldingContext(), SomeExpr(*expr))};
+ lbound = evaluate::ToInt64(folded);
+ evaluate::SetExpr(lbExpr, std::move(folded));
+ }
+ } else {
+ lbound = 1;
+ }
+ if (lbound) {
+ const auto &ubExpr{
+ parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t))};
+ if (const auto *expr{GetExpr(context, ubExpr)}) {
+ auto folded{
+ evaluate::Fold(context.foldingContext(), SomeExpr(*expr))};
+ auto ubound{evaluate::ToInt64(folded)};
+ evaluate::SetExpr(ubExpr, std::move(folded));
+ if (ubound) {
+ auto extent{*ubound - *lbound + 1};
+ if (extent < 0) {
+ extent = 0;
+ }
+ if (extent != allocateInfo_.sourceExprShape->at(j)) {
+ context.Say(name_.source,
+ "Allocation has extent %jd on dimension %d, but SOURCE= has extent %jd"_err_en_US,
+ static_cast<std::intmax_t>(extent), j + 1,
+ static_cast<std::intmax_t>(
+ allocateInfo_.sourceExprShape->at(j)));
+ }
}
}
}
+ ++j;
}
- ++j;
}
}
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 644e0b7853492..cf07df02cdebf 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4519,70 +4519,96 @@ static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_,
return;
}
-MaybeExpr ExpressionAnalyzer::Analyze(const parser::Allocation &x) {
- const int rank1Arrays = countRank1Arrays(x);
- if(rank1Arrays == 0) {
+// Everything comes in as an
+// AllocateShapeSpecArrayList -> AllocateShapeSpecList at the root of the relevant tree,
+// with the assumption that it's a misparse if there is a rank-1 array in at least one of the
+// bounds. So correct the misparse by rewriting from
+// AllocateShapeSpecArrayList -> AllocateShapeSpecList to
+// AllocateShapeSpecArrayList -> AllocateShapeSpecArray.
+// This is necessary, otherwise semantic analysis will fail since AllocateShapeSpec contains
+// a BoundExpr which is just a ScalarIntExpr. We need to place the expression(s) in an
+// AllocateShapeSpecArray because that is typed as a pair of BoundsExpr, which is a
+// (more general) IntExpr. So it will still cover the case of having a scalar broadcast
+// to a rank-1 integer array.
+// In short, if there is at least 1 rank-1 integer array, rewrite this part of the tree
+// to avoid the ScalarIntExpr semantic check and instead pass through the IntExpr semantic
+// check. Since we cannot clone nodes in a tree, we will handle both cases in Lower, both
+// cases being AllocateShapeSpecList and AllocateShapeSpecArray.
+
+// AllocateShapeSpecList isn't explicitly in the dump, but can be inferred from multiple AllocateShapeSpecs.
+// | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
+// | | | Allocation
+// | | | | AllocateObject -> Name = 'arr'
+// | | | | AllocateShapeSpecArrayList -> AllocateShapeSpec
+// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
+// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
+// | | | | AllocateShapeSpec
+// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
+// | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
+// | | | Allocation
+// | | | | AllocateObject -> Name = 'arr'
+// | | | | AllocateShapeSpecArrayList -> AllocateShapeSpec
+// | | | | | Scalar -> Integer -> Expr -> ArrayConstructor -> AcSpec
+// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
+// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '1'
+// | | | | | Scalar -> Integer -> Expr -> ArrayConstructor -> AcSpec
+// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
+// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
+// We can decide that a misparsed AllocateShapeSpecList is supposed to be
+// Aan AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
+// is a rank-1 array.
+// ...existing code...
+MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
+ auto &shapeSpecList{
+ std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
+ if(shapeSpecList.size() != 1) {
return std::nullopt;
}
- auto &shapeSpecList{
- std::get<std::list<parser::AllocateShapeSpec>>(
- (std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
- const auto &shapeSpec{shapeSpecList.front()};
- const auto &lowerBoundOpt = std::get<0>(shapeSpec.t);
+
+ bool foundArray = false;
+
+ // Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
+ const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
+ const auto &upperBoundExpr{parser::UnwrapRef<parser::Expr>(upperBound)};
- std::vector<std::optional<parser::BoundExpr>> lowerBoundOptExprs;
- std::vector<parser::BoundExpr> lowerBoundExprs;
- std::vector<parser::BoundExpr> upperBoundExprs;
- // only upper bound was provided, and rank1Arrays is not 0, so
- // it must be a rank-1 integer array (and rank1Arrays == 1)
- if(!lowerBoundOpt) {
- const auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
- rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
- // fill lowerBoundOptExprs with empty optional, same size as upperBoundExprs
- for(size_t i = 0; i < upperBoundExprs.size(); i++) {
- lowerBoundOptExprs.push_back(std::optional<parser::BoundExpr>{});
- }
- }
- else if (rank1Arrays == 1) { // && lowerBoundOpt
- // we don't know which one is the intArray and which is the scalar integer.
- // since we know we have rank1Arrays == 1, we only need to check one type
- // to determine everything
- auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
- auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
- if(isRank1Array(exprLower)) { // exprLower is array, exprUpper is scalar
- rank1IntArrayToBoundExprs(foldingContext_, lowerBoundExprs, exprLower);
- scalarToBoundExprs(upperBoundExprs, exprUpper, lowerBoundExprs.size());
- }
- else { //exprLower is scalar, exprUpper is array
- rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
- scalarToBoundExprs(lowerBoundExprs, exprLower, upperBoundExprs.size());
- }
- for(size_t i = 0; i < lowerBoundExprs.size(); i++) {
- lowerBoundOptExprs.push_back(std::move(lowerBoundExprs[i]));
- }
- }
- else { // both are arrays
- auto &exprLower = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
- auto &exprUpper = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
- rank1IntArrayToBoundExprs(foldingContext_, lowerBoundExprs, exprLower);
- rank1IntArrayToBoundExprs(foldingContext_, upperBoundExprs, exprUpper);
- for(size_t i = 0; i < lowerBoundExprs.size(); i++) {
- lowerBoundOptExprs.push_back(std::move(lowerBoundExprs[i]));
- }
- }
- std::list<parser::AllocateShapeSpec> newShapeSpecs;
- for(int i = 0; i < upperBoundExprs.size(); i++) {
- // Create new AllocateShapeSpec with optional lower bound and upper bound
- parser::AllocateShapeSpec newSpec =
- std::make_tuple(
- std::move(lowerBoundOptExprs[i]),
- std::move(upperBoundExprs[i]));
- newShapeSpecs.push_back(std::move(newSpec));
- }
- // Replace the original list with expanded specs
- auto &mutableShapeSpecList{const_cast<std::list<parser::AllocateShapeSpec>&>(shapeSpecList)};
- mutableShapeSpecList.clear();
- mutableShapeSpecList.splice(mutableShapeSpecList.end(), newShapeSpecs);
+ if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
+ if(analyzedExpr->Rank() == 1) {
+ foundArray = true;
+ }
+ }
+
+ // Check lower bound if it exists
+ const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
+ if(lowerBoundOpt) {
+ const auto &lowerBoundExpr = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
+ if(analyzedExpr->Rank() == 1) {
+ foundArray = true;
+ }
+ }
+ }
+
+ // Regardless of underlying types, grab BOTH the expressions and wrap in
+ // IntExpr, even if one ended up being a scalar.
+ if(foundArray) {
+ // Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
+ auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
+ parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
+
+ // Handle optional lower bound
+ std::optional<parser::IntExpr> lowerIntExpr;
+ if(lowerBoundOpt) {
+ auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
+ lowerIntExpr = std::move(mutableLowerBound.thing);
+ }
+
+ // Create the AllocateShapeSpecArray and replace the variant
+ parser::AllocateShapeSpecArray boundsExpr{
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
+ mutableArrayList.u = std::move(boundsExpr);
+ }
+
return std::nullopt;
}
>From f1ad4ae19dbdcef6bd52b9b28c354a136d3a1c3f Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 13:17:08 -0600
Subject: [PATCH 15/32] Implement array bounds for genInlinedAllocation,
implement broadcast next
---
flang/lib/Lower/Allocatable.cpp | 70 +++++++++++++++++++++++++++++++--
1 file changed, 66 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index bcfc4fcd18b5f..25dad7a250519 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -412,8 +412,11 @@ class AllocateStmtHelper {
return true;
}
else {
- printf("UNIMPLEMENTED 1, hardcoding true for my case which doesn't use lower bounds\n");
- return true;
+ // For AllocateShapeSpecArray, check if the optional lower bound is present
+ const auto &shapeSpecArray{alloc.getShapeSpecArrays()};
+ // std::get<0> gets the optional<IntExpr> for the lower bound
+ // If it has a value, then lower bounds are not all ones
+ return !std::get<0>(shapeSpecArray.t).has_value();
}
}
@@ -460,9 +463,68 @@ class AllocateStmtHelper {
}
}
else {
- printf("IMPLEMENTING 2\n");
- const auto &array{alloc.getShapeSpecArrays()};
+ // Handle AllocateShapeSpecArray (F2023 array bounds feature)
+ const auto &shapeSpecArray{alloc.getShapeSpecArrays()};
+ const auto &lowerOptBoundsExpr{std::get<0>(shapeSpecArray.t)};
+ const auto &upperBoundsExpr{std::get<1>(shapeSpecArray.t)};
+
+ // Get the semantic expression for the upper bounds array
+ const Fortran::lower::SomeExpr *ubExpr =
+ Fortran::semantics::GetExpr(upperBoundsExpr);
+
+ // Get the constant shape from the semantic expression
+ auto ubShape = Fortran::evaluate::GetShape(
+ converter.getFoldingContext(), *ubExpr);
+
+ // Extract the constant extent from the first (only) dimension
+ const auto &extent = (*ubShape)[0];
+ auto constExtent = Fortran::evaluate::ToInt64(*extent);
+
+ // Evaluate the upper bounds array expression - need address for element access
+ fir::ExtendedValue ubExv = converter.genExprAddr(loc, *ubExpr, stmtCtx);
+ mlir::Value ubBase = fir::getBase(ubExv);
+ // Get the element type from the array
+ auto ubRefTy = mlir::dyn_cast<fir::ReferenceType>(ubBase.getType());
+ auto ubSeqTy = mlir::dyn_cast<fir::SequenceType>(ubRefTy.getEleTy());
+ mlir::Type elemTy = ubSeqTy.getEleTy();
+ mlir::Type elemRefTy = builder.getRefType(elemTy);
+
+ // Handle optional lower bounds
+ mlir::Value lbBase;
+ const Fortran::lower::SomeExpr *lbExpr = nullptr;
+ if (lowerOptBoundsExpr) {
+ lbExpr = Fortran::semantics::GetExpr(*lowerOptBoundsExpr);
+ fir::ExtendedValue lbExv = converter.genExprAddr(loc, *lbExpr, stmtCtx);
+ lbBase = fir::getBase(lbExv);
+ }
+
+ // Extract each element from the bounds arrays
+ for (int64_t i = 0; i < constExtent; ++i) {
+ mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
+
+ // Extract upper bound element
+ mlir::Value ubElemAddr = fir::CoordinateOp::create(builder,
+ loc, elemRefTy, ubBase, idx);
+ mlir::Value ub = fir::LoadOp::create(builder, loc, ubElemAddr);
+ ub = builder.createConvert(loc, idxTy, ub);
+
+ if (lbBase) {
+ // Extract lower bound element
+ mlir::Value lbElemAddr = fir::CoordinateOp::create(builder,
+ loc, elemRefTy, lbBase, idx);
+ mlir::Value lb = fir::LoadOp::create(builder, loc, lbElemAddr);
+ lb = builder.createConvert(loc, idxTy, lb);
+ lbounds.emplace_back(lb);
+
+ // extent = ub - lb + 1
+ mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
+ extents.emplace_back(
+ mlir::arith::AddIOp::create(builder, loc, diff, one));
+ } else {
+ extents.emplace_back(ub);
+ }
+ }
}
fir::factory::genInlinedAllocation(builder, loc, box, lbounds, extents,
lenParams, mangleAlloc(alloc),
>From 274d9e5609a811b7896cd557b79a788c8ae6b664 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 13:33:03 -0600
Subject: [PATCH 16/32] Add broadcast
---
flang/lib/Lower/Allocatable.cpp | 135 ++++++++++++++++++++++----------
1 file changed, 92 insertions(+), 43 deletions(-)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index 25dad7a250519..f3412e3194945 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -468,61 +468,110 @@ class AllocateStmtHelper {
const auto &lowerOptBoundsExpr{std::get<0>(shapeSpecArray.t)};
const auto &upperBoundsExpr{std::get<1>(shapeSpecArray.t)};
- // Get the semantic expression for the upper bounds array
+ // Get the semantic expressions
const Fortran::lower::SomeExpr *ubExpr =
Fortran::semantics::GetExpr(upperBoundsExpr);
+ const Fortran::lower::SomeExpr *lbExpr =
+ lowerOptBoundsExpr ? Fortran::semantics::GetExpr(*lowerOptBoundsExpr)
+ : nullptr;
- // Get the constant shape from the semantic expression
- auto ubShape = Fortran::evaluate::GetShape(
- converter.getFoldingContext(), *ubExpr);
+ // Determine ranks
+ int ubRank = ubExpr->Rank();
+ int lbRank = lbExpr ? lbExpr->Rank() : 0;
- // Extract the constant extent from the first (only) dimension
- const auto &extent = (*ubShape)[0];
- auto constExtent = Fortran::evaluate::ToInt64(*extent);
-
- // Evaluate the upper bounds array expression - need address for element access
- fir::ExtendedValue ubExv = converter.genExprAddr(loc, *ubExpr, stmtCtx);
- mlir::Value ubBase = fir::getBase(ubExv);
-
- // Get the element type from the array
- auto ubRefTy = mlir::dyn_cast<fir::ReferenceType>(ubBase.getType());
- auto ubSeqTy = mlir::dyn_cast<fir::SequenceType>(ubRefTy.getEleTy());
- mlir::Type elemTy = ubSeqTy.getEleTy();
- mlir::Type elemRefTy = builder.getRefType(elemTy);
-
- // Handle optional lower bounds
- mlir::Value lbBase;
- const Fortran::lower::SomeExpr *lbExpr = nullptr;
- if (lowerOptBoundsExpr) {
- lbExpr = Fortran::semantics::GetExpr(*lowerOptBoundsExpr);
- fir::ExtendedValue lbExv = converter.genExprAddr(loc, *lbExpr, stmtCtx);
- lbBase = fir::getBase(lbExv);
+ // Get numDims from whichever bound is an array (at least one must be)
+ int64_t numDims = -1;
+ if (ubRank == 1) {
+ auto ubShape = Fortran::evaluate::GetShape(
+ converter.getFoldingContext(), *ubExpr);
+ if (const auto &extent = (*ubShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
+ numDims = *constExtent;
+ }
+ }
+ } else if (lbRank == 1) {
+ auto lbShape = Fortran::evaluate::GetShape(
+ converter.getFoldingContext(), *lbExpr);
+ if (const auto &extent = (*lbShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
+ numDims = *constExtent;
+ }
+ }
}
+ assert(numDims > 0 && "bounds array must have known constant size");
- // Extract each element from the bounds arrays
- for (int64_t i = 0; i < constExtent; ++i) {
- mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
-
- // Extract upper bound element
- mlir::Value ubElemAddr = fir::CoordinateOp::create(builder,
- loc, elemRefTy, ubBase, idx);
- mlir::Value ub = fir::LoadOp::create(builder, loc, ubElemAddr);
- ub = builder.createConvert(loc, idxTy, ub);
+ // Prepare upper bounds
+ llvm::SmallVector<mlir::Value> ubValues;
+ if (ubRank == 1) {
+ // Upper bounds is an array - extract each element
+ fir::ExtendedValue ubExv = converter.genExprAddr(loc, *ubExpr, stmtCtx);
+ mlir::Value ubBase = fir::getBase(ubExv);
+ auto ubRefTy = mlir::dyn_cast<fir::ReferenceType>(ubBase.getType());
+ auto ubSeqTy = mlir::dyn_cast<fir::SequenceType>(ubRefTy.getEleTy());
+ mlir::Type elemTy = ubSeqTy.getEleTy();
+ mlir::Type elemRefTy = builder.getRefType(elemTy);
- if (lbBase) {
- // Extract lower bound element
- mlir::Value lbElemAddr = fir::CoordinateOp::create(builder,
- loc, elemRefTy, lbBase, idx);
- mlir::Value lb = fir::LoadOp::create(builder, loc, lbElemAddr);
- lb = builder.createConvert(loc, idxTy, lb);
- lbounds.emplace_back(lb);
+ for (int64_t i = 0; i < numDims; ++i) {
+ mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
+ mlir::Value ubElemAddr = fir::CoordinateOp::create(builder,
+ loc, elemRefTy, ubBase, idx);
+ mlir::Value ub = fir::LoadOp::create(builder, loc, ubElemAddr);
+ ub = builder.createConvert(loc, idxTy, ub);
+ ubValues.push_back(ub);
+ }
+ } else {
+ // Upper bounds is a scalar - broadcast to all dimensions
+ mlir::Value ubScalar = fir::getBase(
+ converter.genExprValue(loc, *ubExpr, stmtCtx));
+ ubScalar = builder.createConvert(loc, idxTy, ubScalar);
+ for (int64_t i = 0; i < numDims; ++i) {
+ ubValues.push_back(ubScalar);
+ }
+ }
+
+ // Prepare lower bounds (if present)
+ llvm::SmallVector<mlir::Value> lbValues;
+ if (lbExpr) {
+ if (lbRank == 1) {
+ // Lower bounds is an array - extract each element
+ fir::ExtendedValue lbExv = converter.genExprAddr(loc, *lbExpr, stmtCtx);
+ mlir::Value lbBase = fir::getBase(lbExv);
+ auto lbRefTy = mlir::dyn_cast<fir::ReferenceType>(lbBase.getType());
+ auto lbSeqTy = mlir::dyn_cast<fir::SequenceType>(lbRefTy.getEleTy());
+ mlir::Type elemTy = lbSeqTy.getEleTy();
+ mlir::Type elemRefTy = builder.getRefType(elemTy);
+ for (int64_t i = 0; i < numDims; ++i) {
+ mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
+ mlir::Value lbElemAddr = fir::CoordinateOp::create(builder,
+ loc, elemRefTy, lbBase, idx);
+ mlir::Value lb = fir::LoadOp::create(builder, loc, lbElemAddr);
+ lb = builder.createConvert(loc, idxTy, lb);
+ lbValues.push_back(lb);
+ }
+ } else {
+ // Lower bounds is a scalar - broadcast to all dimensions
+ mlir::Value lbScalar = fir::getBase(
+ converter.genExprValue(loc, *lbExpr, stmtCtx));
+ lbScalar = builder.createConvert(loc, idxTy, lbScalar);
+ for (int64_t i = 0; i < numDims; ++i) {
+ lbValues.push_back(lbScalar);
+ }
+ }
+ }
+
+ // Compute extents from bounds
+ for (int64_t i = 0; i < numDims; ++i) {
+ if (!lbValues.empty()) {
+ lbounds.emplace_back(lbValues[i]);
// extent = ub - lb + 1
- mlir::Value diff = mlir::arith::SubIOp::create(builder, loc, ub, lb);
+ mlir::Value diff = mlir::arith::SubIOp::create(builder, loc,
+ ubValues[i], lbValues[i]);
extents.emplace_back(
mlir::arith::AddIOp::create(builder, loc, diff, one));
} else {
- extents.emplace_back(ub);
+ // No lower bound - extent = upper bound (assumes lb = 1)
+ extents.emplace_back(ubValues[i]);
}
}
}
>From 65785f0781f317501c26b4b556eff8204d4549f7 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 14:01:05 -0600
Subject: [PATCH 17/32] Don't bypass the Integer<> wrapper so we can get
semantic analysis on it's elements, for example: error: Semantic errors in
main.f90 main.f90:3:16: error: Must have INTEGER type, but is REAL(4)
allocate(arr([1.1,2.2] : 3)) ^^^^^^^^^
---
flang/lib/Semantics/expression.cpp | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index cf07df02cdebf..f650ace2305ab 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4569,7 +4569,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
// Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
- const auto &upperBoundExpr{parser::UnwrapRef<parser::Expr>(upperBound)};
+ const auto &upperBoundExpr{upperBound.thing};
if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
if(analyzedExpr->Rank() == 1) {
@@ -4580,7 +4580,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
// Check lower bound if it exists
const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
if(lowerBoundOpt) {
- const auto &lowerBoundExpr = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
+ const auto &lowerBoundExpr{lowerBoundOpt->thing};
if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
if(analyzedExpr->Rank() == 1) {
foundArray = true;
>From a504fe518e743b0a12361b0454fa138105e2dcd5 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 17:00:31 -0600
Subject: [PATCH 18/32] Add semantic error for size check between two array
bounds
---
flang/lib/Semantics/expression.cpp | 35 ++++++++++++++++++++++++++----
1 file changed, 31 insertions(+), 4 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index f650ace2305ab..c49c9dae90511 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4566,14 +4566,26 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
}
bool foundArray = false;
+ int64_t ubSize = -1;
+ int64_t lbSize = -1;
+ int ubRank = 0;
+ int lbRank = 0;
// Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
const auto &upperBoundExpr{upperBound.thing};
if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
- if(analyzedExpr->Rank() == 1) {
+ ubRank = analyzedExpr->Rank();
+ if(ubRank == 1) {
foundArray = true;
+ if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent = ToInt64(*(*shape)[0])) {
+ ubSize = *extent;
+ }
+ }
+ }
}
}
@@ -4582,15 +4594,30 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
if(lowerBoundOpt) {
const auto &lowerBoundExpr{lowerBoundOpt->thing};
if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
- if(analyzedExpr->Rank() == 1) {
+ lbRank = analyzedExpr->Rank();
+ if(lbRank == 1) {
foundArray = true;
+ if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent = ToInt64(*(*shape)[0])) {
+ lbSize = *extent;
+ }
+ }
+ }
}
}
}
- // Regardless of underlying types, grab BOTH the expressions and wrap in
- // IntExpr, even if one ended up being a scalar.
if(foundArray) {
+ // Check for size mismatch BEFORE the rewrite (when both are arrays)
+ if (ubRank == 1 && lbRank == 1 && ubSize > 0 && lbSize > 0 && ubSize != lbSize) {
+ Say("ALLOCATE bounds arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ static_cast<std::intmax_t>(lbSize),
+ static_cast<std::intmax_t>(ubSize));
+ return std::nullopt;
+ }
+
// Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
>From c890aae46d345ec62a8e89cfa3803e62ff1d51be Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 17:23:13 -0600
Subject: [PATCH 19/32] Implement semantic check: length of provided of rank-1
array(s) must match the rank of allocatable object.
---
flang/lib/Semantics/check-allocate.cpp | 50 ++++++++++++++++++++++++++
1 file changed, 50 insertions(+)
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index ae797689bd783..93693724b1df2 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -673,6 +673,56 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
}
}
+ else {
+ // Array bounds specification - check that bounds array size matches object rank
+ const auto &allocateShapeSpecArrayList{
+ std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)};
+ if (const auto *boundsArray{
+ std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u)}) {
+ const auto &lowerOptIntExpr{std::get<0>(boundsArray->t)};
+ const auto &upperIntExpr{std::get<1>(boundsArray->t)};
+
+ int64_t boundsArraySize{-1};
+
+ // Try to get size from upper bounds (always present)
+ if (const auto *upperExpr{GetExpr(context, upperIntExpr)}) {
+ if (upperExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)}) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
+ boundsArraySize = *extent;
+ }
+ }
+ }
+ }
+ }
+
+ // If upper was scalar, try to get size from lower bounds
+ if (boundsArraySize < 0 && lowerOptIntExpr) {
+ if (const auto *lowerExpr{GetExpr(context, *lowerOptIntExpr)}) {
+ if (lowerExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
+ boundsArraySize = *extent;
+ }
+ }
+ }
+ }
+ }
+ }
+
+ // Check if bounds array size matches the object's rank
+ if (boundsArraySize > 0 && boundsArraySize != rank_) {
+ context.Say(name_.source,
+ "ALLOCATE bounds array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(boundsArraySize),
+ name_.source,
+ rank_);
+ return false;
+ }
+ }
+ }
}
} else { // allocating a scalar object
if (hasAllocateShapeSpecList()) {
>From e38df6651ee381d7834224cdba07639427e8c2f7 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 26 Jan 2026 18:19:06 -0600
Subject: [PATCH 20/32] Cleanup
---
flang/include/flang/Parser/parse-tree.h | 15 ---
flang/lib/Semantics/check-allocate.cpp | 2 -
flang/lib/Semantics/expression.cpp | 145 +-----------------------
3 files changed, 1 insertion(+), 161 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 7219ea40b897c..dd17ef9db90df 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1961,21 +1961,6 @@ struct AllocateShapeSpecArrayList {
};
struct Allocation {
TUPLE_CLASS_BOILERPLATE(Allocation);
- // What was previously there but I formatted it.
- // std::tuple<
- // AllocateObject,
- // std::list<AllocateShapeSpec>,
- // std::optional<AllocateCoarraySpec>
- // >
- // I think this is what I want but can't have nested tuples.
- // Use a wrapper on innermost tuple.
- // std::tuple<
- // AllocateObject,
- // std::variant<
- // std::list<AllocateShapeSpec>,
- // std::tuple<std::optional<BoundsExpr>, BoundsExpr>,
- // std::optional<AllocateCoarraySpec>>
- // t;
std::tuple<
AllocateObject,
AllocateShapeSpecArrayList,
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 93693724b1df2..f306d33a7d118 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -616,7 +616,6 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
// explicit shape-spec-list
if (!isArray) {
if (allocateShapeSpecRank_ != rank_) {
- printf("%d != %d\n", allocateShapeSpecRank_, rank_);
context
.Say(name_.source,
"The number of shape specifications, when they appear, must match the rank of allocatable object"_err_en_US)
@@ -627,7 +626,6 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
allocateInfo_.sourceExprShape->size() ==
static_cast<std::size_t>(allocateShapeSpecRank_)) {
std::size_t j{0};
- printf("bool AllocationCheckerHelper::RunChecks in Semantics/check-allocate.cpp\n");
for (const auto &shapeSpec :
std::get<std::list<parser::AllocateShapeSpec>>((std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)).u)) {
if (j >= allocateInfo_.sourceExprShape->size()) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index c49c9dae90511..4e8732194e937 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4377,148 +4377,6 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
return ExprOrVariable(x, parser::FindSourceLocation(x));
}
-static bool isRank1Array(const parser::Expr& expr) {
- if(std::get_if<parser::ArrayConstructor>(&expr.u)) {
- return true;
- }
- else if(const auto *designator{
- std::get_if<common::Indirection<parser::Designator>>(&expr.u)}) {
- if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
- if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
- if (const Symbol *symbol{name->symbol}) {
- int varRank{symbol->Rank()};
- if (varRank == 1) {
- return true;
- }
- }
- }
- }
- }
- return false;
-}
-
-// returns 0, 1, or 2
-static int countRank1Arrays(const parser::Allocation &x) {
- int result = 0;
- auto &shapeSpecList{
- std::get<std::list<parser::AllocateShapeSpec>>(
- (std::get<parser::AllocateShapeSpecArrayList>(x.t)).u)};
- const auto &shapeSpec{shapeSpecList.front()};
-
- const auto &upperExpr = parser::UnwrapRef<parser::Expr>(std::get<1>(shapeSpec.t));
- if(isRank1Array(upperExpr)) {
- result++;
- }
- const auto &lowerBoundOpt = std::get<0>(shapeSpec.t);
- if(lowerBoundOpt) {
- const auto &upperExpr = parser::UnwrapRef<parser::Expr>(*lowerBoundOpt);
- if(isRank1Array(upperExpr)) {
- result++;
- }
- }
- return result;
-}
-
-static void scalarToBoundExprs(std::vector<parser::BoundExpr>& exprsList, const parser::Expr& scalarInt, int count) {
- if(const auto *literalConst{
- std::get_if<parser::LiteralConstant>(&scalarInt.u) }) {
- if(const auto *intConst{
- std::get_if<parser::IntLiteralConstant>(&literalConst->u)}) {
- for(size_t i = 0; i < count; i++) {
- parser::BoundExpr boundExpr{parser::Integer(
- common::Indirection<parser::Expr>{
- parser::Expr{std::move(const_cast<parser::LiteralConstant&>(*literalConst))}
- })};
- exprsList.push_back(std::move(boundExpr));
- }
- }
- }
-}
-
-// handles both ArrayConstructor and Designator
-static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_, std::vector<parser::BoundExpr>& exprsList, const parser::Expr& designatorOrArrayCtrExpr) {
- if (const auto *arrayConstructor{
- std::get_if<parser::ArrayConstructor>(&designatorOrArrayCtrExpr.u)}) {
- const auto &acSpec{arrayConstructor->v}; // AcSpec
- const auto &acValues{std::get<1>(acSpec.t)}; // Get the list of values
- for (const auto &acValue : acValues) {
- if (const auto *indirExpr =
- std::get_if<common::Indirection<parser::Expr>>(&acValue.u)) {
- parser::BoundExpr newBoundExpr{parser::Integer(
- std::move(const_cast<common::Indirection<parser::Expr>&>(*indirExpr)))};
- exprsList.push_back(std::move(newBoundExpr));
- }
- }
- }
- else if(const auto *designator{
- std::get_if<common::Indirection<parser::Designator>>(&designatorOrArrayCtrExpr.u)}) {
- // Handle Designator case: allocate(array(dims)) where dims is a variable
- if (const auto *dataRef{std::get_if<parser::DataRef>(&designator->value().u)}) {
- if (const auto *name{std::get_if<parser::Name>(&dataRef->u)}) {
- // It's a simple name reference like 'dims'
- if (const Symbol *symbol{name->symbol}) {
- int varRank{symbol->Rank()};
- // Only expand if it's a 1D array (dims is rank-1)
- if (varRank == 1) {
- // Get the size of the dims array from its type
- if (const auto shape{GetShape(foldingContext_, *symbol)}) {
- if (auto dimSize{ToInt64(shape->at(0))}) {
- for (std::int64_t i = 0; i < *dimSize; ++i) {
- // Get lower bound of dims array (dimension 0)
- auto lowerBound{GetLBOUND(foldingContext_, NamedEntity{*symbol}, 0)};
- auto lb{ToInt64(lowerBound)};
- std::int64_t subscriptIndex = (lb ? *lb : 1) + i;
-
- static const char* subscriptStrings[] = {"1", "2", "3", "4", "5", "6", "7", "8", "9"};
- const char* subscriptStr = (subscriptIndex <= 9) ? subscriptStrings[subscriptIndex-1] : "?";
-
- // Create the integer subscript expression: dims(i)
- auto literalInt = parser::IntLiteralConstant{
- parser::CharBlock{subscriptStr, 1},
- std::optional<parser::KindParam>{}
- };
-
- auto subscriptExpr = common::Indirection<parser::Expr>{
- parser::Expr{
- parser::LiteralConstant{std::move(literalInt)}
- }
- };
-
- // Create subscript list: [dims(i)]
- std::list<parser::SectionSubscript> subscripts;
- subscripts.emplace_back(parser::IntExpr{std::move(subscriptExpr)});
-
- // Create PartRef with the name and subscripts - move the Name
- std::list<parser::PartRef> partRefs;
- partRefs.emplace_back(
- std::move(const_cast<parser::Name&>(*name)),
- std::move(subscripts),
- std::optional<parser::ImageSelector>{}
- );
-
- // Create DataRef from the PartRef
- parser::DataRef dataRef{std::move(partRefs)};
-
- // Create the full designator: dims(i)
- auto dimDesignator = parser::Designator{std::move(dataRef)};
- auto dimExpr = common::Indirection<parser::Expr>{
- parser::Expr{std::move(dimDesignator)}
- };
-
- // Create BoundExpr wrapping the subscripted reference
- parser::BoundExpr newBoundExpr{parser::Integer{std::move(dimExpr)}};
- exprsList.push_back(std::move(newBoundExpr));
- }
- }
- }
- }
- }
- }
- }
- }
- return;
-}
-
// Everything comes in as an
// AllocateShapeSpecArrayList -> AllocateShapeSpecList at the root of the relevant tree,
// with the assumption that it's a misparse if there is a rank-1 array in at least one of the
@@ -4555,9 +4413,8 @@ static void rank1IntArrayToBoundExprs(evaluate::FoldingContext& foldingContext_,
// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
// We can decide that a misparsed AllocateShapeSpecList is supposed to be
-// Aan AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
+// an AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
// is a rank-1 array.
-// ...existing code...
MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
>From 5e9d00384183703110b2b58eaf450de919918a37 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 30 Jan 2026 20:08:38 -0600
Subject: [PATCH 21/32] Fix failing tests
---
flang/lib/Semantics/check-allocate.cpp | 2 +-
flang/lib/Semantics/expression.cpp | 15 ++++++++++++++-
2 files changed, 15 insertions(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index f306d33a7d118..b9934ae9bd301 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -592,7 +592,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
return false;
}
if (rank_ > 0) {
- if(!isArray) {
+ if(!isArray && !hasAllocateShapeSpecList()) {
if (!hasAllocateShapeSpecList()) {
// C939
if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 4e8732194e937..3e8d1393305cd 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4418,7 +4418,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
- if(shapeSpecList.size() != 1) {
+ if(shapeSpecList.size() == 0) {
return std::nullopt;
}
@@ -4491,6 +4491,19 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
mutableArrayList.u = std::move(boundsExpr);
+ } else {
+ // start from second entry and analyze each AllocateShapeSpec, since at this point
+ // we know we're not an AllocateShapeSpecArray
+ for(auto it = std::next(shapeSpecList.begin()); it != shapeSpecList.end(); ++it) {
+ // Analyze upper bound (required)
+ const auto &upperBound{std::get<1>(it->t)};
+ Analyze(upperBound.thing);
+ // Analyze lower bound if present
+ const auto &lowerBoundOpt{std::get<0>(it->t)};
+ if(lowerBoundOpt) {
+ Analyze(lowerBoundOpt->thing);
+ }
+ }
}
return std::nullopt;
>From ce86cf851cee598ba7bdc962b410367c488f74f9 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 30 Jan 2026 21:51:58 -0600
Subject: [PATCH 22/32] Don't return early on error from Analyze(const
parser::AllocateShapeSpecArrayList &x) so we still repackage in
AllocateShapeSpecArray. Don't print error if lower/upper has same size but
mismatched with allocate object.
---
flang/lib/Semantics/check-allocate.cpp | 13 +++++-----
flang/lib/Semantics/expression.cpp | 4 +--
.../test/Semantics/allocate_array_bounds.f90 | 26 +++++++++++++++++++
3 files changed, 35 insertions(+), 8 deletions(-)
create mode 100644 flang/test/Semantics/allocate_array_bounds.f90
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index b9934ae9bd301..5c031726f3da6 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -680,7 +680,8 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
const auto &lowerOptIntExpr{std::get<0>(boundsArray->t)};
const auto &upperIntExpr{std::get<1>(boundsArray->t)};
- int64_t boundsArraySize{-1};
+ int64_t upperBoundsArraySize{-1};
+ int64_t lowerBoundsArraySize{-1};
// Try to get size from upper bounds (always present)
if (const auto *upperExpr{GetExpr(context, upperIntExpr)}) {
@@ -688,7 +689,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)}) {
if (shape->size() == 1 && (*shape)[0]) {
if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- boundsArraySize = *extent;
+ upperBoundsArraySize = *extent;
}
}
}
@@ -696,13 +697,13 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
// If upper was scalar, try to get size from lower bounds
- if (boundsArraySize < 0 && lowerOptIntExpr) {
+ if (lowerOptIntExpr) {
if (const auto *lowerExpr{GetExpr(context, *lowerOptIntExpr)}) {
if (lowerExpr->Rank() == 1) {
if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
if (shape->size() == 1 && (*shape)[0]) {
if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- boundsArraySize = *extent;
+ lowerBoundsArraySize = *extent;
}
}
}
@@ -711,10 +712,10 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
// Check if bounds array size matches the object's rank
- if (boundsArraySize > 0 && boundsArraySize != rank_) {
+ if ((lowerBoundsArraySize == upperBoundsArraySize) && (upperBoundsArraySize > 0) && (upperBoundsArraySize != rank_)) {
context.Say(name_.source,
"ALLOCATE bounds array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
- static_cast<std::intmax_t>(boundsArraySize),
+ static_cast<std::intmax_t>(upperBoundsArraySize),
name_.source,
rank_);
return false;
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 3e8d1393305cd..22aed024db428 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4468,11 +4468,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
if(foundArray) {
// Check for size mismatch BEFORE the rewrite (when both are arrays)
if (ubRank == 1 && lbRank == 1 && ubSize > 0 && lbSize > 0 && ubSize != lbSize) {
- Say("ALLOCATE bounds arrays must have the same size; "
+ parser::CharBlock at{parser::FindSourceLocation(upperBoundExpr)};
+ Say(at, "ALLOCATE bounds arrays must have the same size; "
"lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
static_cast<std::intmax_t>(lbSize),
static_cast<std::intmax_t>(ubSize));
- return std::nullopt;
}
// Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
new file mode 100644
index 0000000000000..b8f5a947652bb
--- /dev/null
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -0,0 +1,26 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+program int_array_alloc_03
+ implicit none
+ real, allocatable, dimension(:,:,:) :: test_array_01
+ real, allocatable, dimension(:,:,:) :: test_array_02
+ real, allocatable, dimension(:,:,:) :: test_array_03
+
+ integer :: lower(4), upper(4)
+
+ !ERROR: ALLOCATE bounds arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
+ allocate( test_array_01([1,2,3]:[3,3]))
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ allocate( test_array_02([1.2,2.2,3.2]:[1,2,3]))
+ !ERROR: ALLOCATE bounds array has 4 elements but allocatable object 'test_array_03' has rank 3
+ allocate( test_array_03(lower:upper) )
+
+! contains
+! subroutine tmp02(unknown_size, test_ptr_01)
+! real, allocatable, dimension(:,:,:), INTENT(OUT) :: test_ptr_01
+! integer, INTENT(IN) :: unknown_size
+! integer :: upper(unknown_size)
+
+! allocate(test_ptr_01(upper))
+! end subroutine
+
+end program
>From f26d65100a6b98d91990d76a79dcc86cbab670d1 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 2 Feb 2026 15:28:28 -0600
Subject: [PATCH 23/32] Change variable name
---
flang/lib/Lower/Allocatable.cpp | 28 ++++++++++++++--------------
1 file changed, 14 insertions(+), 14 deletions(-)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index f3412e3194945..cee3290e7f995 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -479,26 +479,26 @@ class AllocateStmtHelper {
int ubRank = ubExpr->Rank();
int lbRank = lbExpr ? lbExpr->Rank() : 0;
- // Get numDims from whichever bound is an array (at least one must be)
- int64_t numDims = -1;
+ // Get extent from whichever bound is an array (at least one must be)
+ int64_t extent = -1;
if (ubRank == 1) {
auto ubShape = Fortran::evaluate::GetShape(
converter.getFoldingContext(), *ubExpr);
- if (const auto &extent = (*ubShape)[0]) {
- if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
- numDims = *constExtent;
+ if (const auto &_extent = (*ubShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*_extent)) {
+ extent = *constExtent;
}
}
} else if (lbRank == 1) {
auto lbShape = Fortran::evaluate::GetShape(
converter.getFoldingContext(), *lbExpr);
- if (const auto &extent = (*lbShape)[0]) {
- if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
- numDims = *constExtent;
+ if (const auto &_extent = (*lbShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*_extent)) {
+ extent = *constExtent;
}
}
}
- assert(numDims > 0 && "bounds array must have known constant size");
+ assert(extent > 0 && "bounds array must have known constant size");
// Prepare upper bounds
llvm::SmallVector<mlir::Value> ubValues;
@@ -511,7 +511,7 @@ class AllocateStmtHelper {
mlir::Type elemTy = ubSeqTy.getEleTy();
mlir::Type elemRefTy = builder.getRefType(elemTy);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
mlir::Value ubElemAddr = fir::CoordinateOp::create(builder,
loc, elemRefTy, ubBase, idx);
@@ -524,7 +524,7 @@ class AllocateStmtHelper {
mlir::Value ubScalar = fir::getBase(
converter.genExprValue(loc, *ubExpr, stmtCtx));
ubScalar = builder.createConvert(loc, idxTy, ubScalar);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
ubValues.push_back(ubScalar);
}
}
@@ -541,7 +541,7 @@ class AllocateStmtHelper {
mlir::Type elemTy = lbSeqTy.getEleTy();
mlir::Type elemRefTy = builder.getRefType(elemTy);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
mlir::Value lbElemAddr = fir::CoordinateOp::create(builder,
loc, elemRefTy, lbBase, idx);
@@ -554,14 +554,14 @@ class AllocateStmtHelper {
mlir::Value lbScalar = fir::getBase(
converter.genExprValue(loc, *lbExpr, stmtCtx));
lbScalar = builder.createConvert(loc, idxTy, lbScalar);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
lbValues.push_back(lbScalar);
}
}
}
// Compute extents from bounds
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
if (!lbValues.empty()) {
lbounds.emplace_back(lbValues[i]);
// extent = ub - lb + 1
>From 6359fe0b26f391157149e241167e993ff4754742 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 6 Feb 2026 20:10:26 -0600
Subject: [PATCH 24/32] Move check from expression.cpp to check-semantics.cpp.
That is, expression.cpp should only determine if rewrite is necessary and do
the rewrite. For check-allocate.cpp, add constant size checks, rank-1 checks,
matching size check, and missing case size check for scalar broadcast +
rank-1 array
---
flang/lib/Semantics/check-allocate.cpp | 72 +++++++++++++++----
flang/lib/Semantics/expression.cpp | 42 ++---------
.../test/Semantics/allocate_array_bounds.f90 | 45 +++++++++---
3 files changed, 99 insertions(+), 60 deletions(-)
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 5c031726f3da6..8e46b9d1df8fa 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -672,9 +672,9 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
}
else {
- // Array bounds specification - check that bounds array size matches object rank
const auto &allocateShapeSpecArrayList{
std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)};
+ //TODO: change to get, remove if
if (const auto *boundsArray{
std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u)}) {
const auto &lowerOptIntExpr{std::get<0>(boundsArray->t)};
@@ -682,44 +682,90 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
int64_t upperBoundsArraySize{-1};
int64_t lowerBoundsArraySize{-1};
+
+ // We can check both bounds and report multiple errors instead of returning immediately.
+ bool flaggedNonConstSize{false}, flaggedRank{false};
+ const auto *upperExpr{GetExpr(context, upperIntExpr)};
+ const auto *lowerExpr{lowerOptIntExpr ? GetExpr(context, *lowerOptIntExpr) : nullptr};
// Try to get size from upper bounds (always present)
- if (const auto *upperExpr{GetExpr(context, upperIntExpr)}) {
+ if (upperExpr) {
if (upperExpr->Rank() == 1) {
if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)}) {
if (shape->size() == 1 && (*shape)[0]) {
if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
upperBoundsArraySize = *extent;
}
+ else {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "Rank-1 integer array used as upper bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
+ }
}
}
}
+ else if(upperExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, upperExpr->Rank());
+ flaggedRank = true;
+ }
}
- // If upper was scalar, try to get size from lower bounds
- if (lowerOptIntExpr) {
- if (const auto *lowerExpr{GetExpr(context, *lowerOptIntExpr)}) {
- if (lowerExpr->Rank() == 1) {
- if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- lowerBoundsArraySize = *extent;
- }
+ if (lowerExpr) {
+ if (lowerExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
+ lowerBoundsArraySize = *extent;
+ }
+ else {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "Rank-1 integer array used as lower bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
}
}
}
+ } else if(lowerExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, lowerExpr->Rank());
+ flaggedRank = true;
}
}
+
+ // Errors after this don't make sense to check if the previous checks failed
+ if(flaggedNonConstSize || flaggedRank) return false;
+
+ if((lowerBoundsArraySize > 0) && (upperBoundsArraySize > 0) && lowerBoundsArraySize != upperBoundsArraySize) {
+ parser::CharBlock at{parser::FindSourceLocation(*boundsArray)};
+ context.Say(at, "ALLOCATE bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ static_cast<std::intmax_t>(upperBoundsArraySize));
+ return false;
+ }
- // Check if bounds array size matches the object's rank
if ((lowerBoundsArraySize == upperBoundsArraySize) && (upperBoundsArraySize > 0) && (upperBoundsArraySize != rank_)) {
context.Say(name_.source,
- "ALLOCATE bounds array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ "ALLOCATE bounds integer rank-1 arrays have %jd elements but allocatable object '%s' has rank %d"_err_en_US,
static_cast<std::intmax_t>(upperBoundsArraySize),
name_.source,
rank_);
return false;
}
+ else if(upperBoundsArraySize > -1 && lowerBoundsArraySize == -1 && upperBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "ALLOCATE upper bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(upperBoundsArraySize),
+ name_.source,
+ rank_);
+ }
+ else if(lowerBoundsArraySize > -1 && upperBoundsArraySize == -1 && lowerBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "ALLOCATE lower bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ name_.source,
+ rank_);
+ }
}
}
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 22aed024db428..8d278be77b8a8 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4414,7 +4414,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
// We can decide that a misparsed AllocateShapeSpecList is supposed to be
// an AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
-// is a rank-1 array.
+// is an array (rank > 0). We will check that it is a rank-1 array
+// as part of other error checks in check-allocate.cpp.
MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
@@ -4422,28 +4423,14 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
return std::nullopt;
}
- bool foundArray = false;
- int64_t ubSize = -1;
- int64_t lbSize = -1;
- int ubRank = 0;
- int lbRank = 0;
+ bool foundArray{false};
// Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
const auto &upperBoundExpr{upperBound.thing};
if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
- ubRank = analyzedExpr->Rank();
- if(ubRank == 1) {
- foundArray = true;
- if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent = ToInt64(*(*shape)[0])) {
- ubSize = *extent;
- }
- }
- }
- }
+ foundArray = analyzedExpr->Rank() > 0;
}
// Check lower bound if it exists
@@ -4451,30 +4438,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
if(lowerBoundOpt) {
const auto &lowerBoundExpr{lowerBoundOpt->thing};
if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
- lbRank = analyzedExpr->Rank();
- if(lbRank == 1) {
- foundArray = true;
- if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent = ToInt64(*(*shape)[0])) {
- lbSize = *extent;
- }
- }
- }
- }
+ foundArray |= analyzedExpr->Rank() > 0;
}
}
if(foundArray) {
- // Check for size mismatch BEFORE the rewrite (when both are arrays)
- if (ubRank == 1 && lbRank == 1 && ubSize > 0 && lbSize > 0 && ubSize != lbSize) {
- parser::CharBlock at{parser::FindSourceLocation(upperBoundExpr)};
- Say(at, "ALLOCATE bounds arrays must have the same size; "
- "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
- static_cast<std::intmax_t>(lbSize),
- static_cast<std::intmax_t>(ubSize));
- }
-
// Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index b8f5a947652bb..9cd8638ad9038 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -6,21 +6,46 @@ program int_array_alloc_03
real, allocatable, dimension(:,:,:) :: test_array_03
integer :: lower(4), upper(4)
+ integer :: rank_2_array(3,3), rank_3_array(3,3,3)
- !ERROR: ALLOCATE bounds arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array_01([1,2,3]:[3,3]))
!ERROR: Must have INTEGER type, but is REAL(4)
allocate( test_array_02([1.2,2.2,3.2]:[1,2,3]))
- !ERROR: ALLOCATE bounds array has 4 elements but allocatable object 'test_array_03' has rank 3
+
+ !ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
+ allocate( test_array_01([1,2,3]:[3,3]))
+
+ !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array_03' has rank 3
allocate( test_array_03(lower:upper) )
+ !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array_03' has rank 3
+ allocate( test_array_03(7 : [1,2,3,4]))
+ !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array_03' has rank 3
+ allocate( test_array_03([1,2] : 7))
-! contains
-! subroutine tmp02(unknown_size, test_ptr_01)
-! real, allocatable, dimension(:,:,:), INTENT(OUT) :: test_ptr_01
-! integer, INTENT(IN) :: unknown_size
-! integer :: upper(unknown_size)
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03([1,2,4] : rank_3_array))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ allocate( test_array_03(rank_2_array : [1,2,4]))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03(rank_2_array : rank_3_array))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ allocate( test_array_03(rank_2_array : 7))
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03(7 : rank_3_array))
+
+ contains
+ subroutine tmp02(unknown_size, test_ptr_01)
+ real, allocatable, dimension(:,:,:), INTENT(OUT) :: test_ptr_01
+ integer, INTENT(IN) :: unknown_size
+ integer :: lower(unknown_size), upper(unknown_size)
-! allocate(test_ptr_01(upper))
-! end subroutine
+ !ERROR: Rank-1 integer array used as upper bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(upper))
+ !ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
+ !ERROR: Rank-1 integer array used as upper bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(lower : upper))
+ !ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(lower : 10))
+ end subroutine
end program
>From 59dc2b24cfaaa49385c1ff37ba4aee1b37b78f73 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 11:29:18 -0600
Subject: [PATCH 25/32] Rewrite tree even if element type is wrong. This
prevents us from throwing false AllocateShapeSpecList size errors when
erroring on the type (because it prevented rewrite). Also, be more specific
by requiring rewrite to have size 1, otherwise we accept weird cases like
allocate([1,2,3], 1).
---
flang/lib/Semantics/expression.cpp | 92 ++++++++++---------
.../test/Semantics/allocate_array_bounds.f90 | 38 ++++----
2 files changed, 71 insertions(+), 59 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 8d278be77b8a8..87dfa9fe193fd 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4423,54 +4423,60 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
return std::nullopt;
}
- bool foundArray{false};
-
- // Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
- const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
- const auto &upperBoundExpr{upperBound.thing};
-
- if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
- foundArray = analyzedExpr->Rank() > 0;
- }
-
- // Check lower bound if it exists
- const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
- if(lowerBoundOpt) {
- const auto &lowerBoundExpr{lowerBoundOpt->thing};
- if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
- foundArray |= analyzedExpr->Rank() > 0;
- }
- }
-
- if(foundArray) {
- // Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
- auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
- parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
-
- // Handle optional lower bound
- std::optional<parser::IntExpr> lowerIntExpr;
+ if(shapeSpecList.size() == 1) {
+ // Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
+ const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
+ const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
+ bool foundArray{false};
+ // We want to rewrite as an AllocateShapeSpecArray even if
+ // the element type is wrong (say a real instead of integer), so
+ // analyze as an unwrapped Expr for its rank, then analyze as
+ // an Integer<Indirection<Expr>>.
+ if(MaybeExpr analyzedExpr = Analyze(upperBound.thing.thing.value())) {
+ if(analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ Analyze(upperBound.thing);
+ }
+ }
if(lowerBoundOpt) {
- auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
- lowerIntExpr = std::move(mutableLowerBound.thing);
+ const auto &lowerBound{*lowerBoundOpt};
+ if(MaybeExpr analyzedExpr = Analyze(lowerBound.thing.thing.value())) {
+ if(analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ Analyze(lowerBound.thing);
+ }
+ }
}
- // Create the AllocateShapeSpecArray and replace the variant
- parser::AllocateShapeSpecArray boundsExpr{
- std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
- auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
- mutableArrayList.u = std::move(boundsExpr);
- } else {
- // start from second entry and analyze each AllocateShapeSpec, since at this point
- // we know we're not an AllocateShapeSpecArray
- for(auto it = std::next(shapeSpecList.begin()); it != shapeSpecList.end(); ++it) {
- // Analyze upper bound (required)
- const auto &upperBound{std::get<1>(it->t)};
- Analyze(upperBound.thing);
- // Analyze lower bound if present
- const auto &lowerBoundOpt{std::get<0>(it->t)};
+ if(foundArray) {
+ // Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
+ auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
+ parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
+
+ // Handle optional lower bound
+ std::optional<parser::IntExpr> lowerIntExpr;
if(lowerBoundOpt) {
- Analyze(lowerBoundOpt->thing);
+ auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
+ lowerIntExpr = std::move(mutableLowerBound.thing);
}
+
+ // Create the AllocateShapeSpecArray and replace the variant
+ parser::AllocateShapeSpecArray boundsExpr{
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
+ mutableArrayList.u = std::move(boundsExpr);
+
+ return std::nullopt;
+ }
+ }
+
+// Analyze each AllocateShapeSpec, as a Scalar<Int<Expr>>
+ for(auto it = shapeSpecList.begin(); it != shapeSpecList.end(); ++it) {
+ const auto &upperBound{std::get<1>(it->t)};
+ Analyze(upperBound);
+ const auto &lowerBoundOpt{std::get<0>(it->t)};
+ if(lowerBoundOpt) {
+ Analyze(*lowerBoundOpt);
}
}
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index 9cd8638ad9038..fc132b7137a11 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -1,37 +1,43 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
program int_array_alloc_03
implicit none
- real, allocatable, dimension(:,:,:) :: test_array_01
- real, allocatable, dimension(:,:,:) :: test_array_02
- real, allocatable, dimension(:,:,:) :: test_array_03
+ real, allocatable, dimension(:,:,:) :: test_array
integer :: lower(4), upper(4)
integer :: rank_2_array(3,3), rank_3_array(3,3,3)
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array_02([1.2,2.2,3.2]:[1,2,3]))
+ allocate( test_array([1.2,2.2,3.2]:[1,2,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array_01([1,2,3]:[3,3]))
+ allocate( test_array([1,2,3]:[3,3]))
- !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03(lower:upper) )
- !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03(7 : [1,2,3,4]))
- !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03([1,2] : 7))
+ !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array(lower:upper) )
+ !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array(7 : [1,2,3,4]))
+ !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array([1,2] : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03([1,2,4] : rank_3_array))
+ allocate( test_array([1,2,4] : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array_03(rank_2_array : [1,2,4]))
+ allocate( test_array(rank_2_array : [1,2,4]))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03(rank_2_array : rank_3_array))
+ allocate( test_array(rank_2_array : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array_03(rank_2_array : 7))
+ allocate( test_array(rank_2_array : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03(7 : rank_3_array))
+ allocate( test_array(7 : rank_3_array))
+
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten, giving error messages expecting scalar integers
+ ! and same number of aruments as rank of test_array
+ !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ allocate( test_array([1,2] : [2,3], 3, [1,2,3], 5))
contains
subroutine tmp02(unknown_size, test_ptr_01)
>From 4dbb7d758d1934ef0743ac8ab7dcf896fcbd0096 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 14:32:43 -0600
Subject: [PATCH 26/32] Add test to ensure we don't allow cases where first
comma item fits the AllocateShapeSpecArray case
---
flang/test/Semantics/allocate_array_bounds.f90 | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index fc132b7137a11..16f727049ab25 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -31,13 +31,15 @@ program int_array_alloc_03
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
allocate( test_array(7 : rank_3_array))
- ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten, giving error messages expecting scalar integers
- ! and same number of aruments as rank of test_array
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten,
+ ! giving error messages expecting same number of
+ ! aruments as rank of test_array and scalar integers
!ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
- allocate( test_array([1,2] : [2,3], 3, [1,2,3], 5))
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ allocate( test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
contains
subroutine tmp02(unknown_size, test_ptr_01)
>From 0da9e4dabe5be3541fafc78cb84c14a53004de94 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 14:51:45 -0600
Subject: [PATCH 27/32] Add positive test cases
---
.../test/Semantics/allocate_array_bounds.f90 | 51 ++++++++++++++-----
1 file changed, 38 insertions(+), 13 deletions(-)
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index 16f727049ab25..634a69699ff94 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -1,45 +1,65 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
program int_array_alloc_03
implicit none
+ real, allocatable, dimension(:) :: rank1_test_array
real, allocatable, dimension(:,:,:) :: test_array
+ integer :: seven = 7
+ integer :: valid_lower(3) = [1,1,1]
integer :: lower(4), upper(4)
integer :: rank_2_array(3,3), rank_3_array(3,3,3)
+ ! Positive test cases, expecting no errors
+ ! Test direct use of scalar integer and array integer expressions
+ allocate(rank1_test_array([5]))
+ allocate(rank1_test_array([1]:[5]))
+ allocate(rank1_test_array(1:[5]))
+ allocate(rank1_test_array([1]:5))
+
+ ! Test indirect use of scalar integer and array integer expressions
+ ! array : array
+ allocate(test_array([1,2,3] : [1,2,3] + 1))
+ ! array : array
+ allocate(test_array(valid_lower - 1 : seven * (valid_lower + seven)))
+ ! array : scalar (broadcast)
+ allocate(test_array(valid_lower : return_seven()))
+ ! scalar : array (broadcast)
+ allocate(test_array(seven : [9,9,9]))
+ !Negative test cases, expecting errors
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array([1.2,2.2,3.2]:[1,2,3]))
+ allocate(test_array([1.2,2.2,3.2]:[1,2,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array([1,2,3]:[3,3]))
+ allocate(test_array([1,2,3]:[3,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array' has rank 3
- allocate( test_array(lower:upper) )
+ allocate(test_array(lower:upper))
!ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array' has rank 3
- allocate( test_array(7 : [1,2,3,4]))
+ allocate(test_array(7 : [1,2,3,4]))
!ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array' has rank 3
- allocate( test_array([1,2] : 7))
+ allocate(test_array([1,2] : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array([1,2,4] : rank_3_array))
+ allocate(test_array([1,2,4] : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array(rank_2_array : [1,2,4]))
+ allocate(test_array(rank_2_array : [1,2,4]))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array(rank_2_array : rank_3_array))
+ allocate(test_array(rank_2_array : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array(rank_2_array : 7))
+ allocate(test_array(rank_2_array : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array(7 : rank_3_array))
+ allocate(test_array(7 : rank_3_array))
- ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten,
- ! giving error messages expecting same number of
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten
+ ! to AllocateShapeSpecArray, giving error messages expecting same number of
! aruments as rank of test_array and scalar integers
!ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
+ allocate(test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
contains
subroutine tmp02(unknown_size, test_ptr_01)
@@ -55,5 +75,10 @@ subroutine tmp02(unknown_size, test_ptr_01)
!ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
allocate(test_ptr_01(lower : 10))
end subroutine
+
+ function return_seven()
+ integer :: return_seven
+ return_seven = 7
+ end function
end program
>From 5a9fd9585930b1fe456d053d631e0a6c96470574 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 16 Feb 2026 18:44:22 -0600
Subject: [PATCH 28/32] Changes to be able to hardcode and rewrite a list of
ExplicitShapeBoundsSpec
This happens unconditionally. Add logic to detect and differentiate, just like in the allocate statement. Differing from Allocate though, is that the expressions here have to be const.
---
flang/lib/Parser/unparse.cpp | 4 ++++
flang/lib/Semantics/resolve-names-utils.cpp | 3 +++
2 files changed, 7 insertions(+)
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index ab20ac2a91728..f7d8ef43bffe9 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -567,6 +567,10 @@ class UnparseVisitor {
Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":");
Walk(std::get<SpecificationExpr>(x.t));
}
+ void Unparse(const ExplicitShapeBoundsSpec &x) {
+ // TODO: don't remember if this was needed to compile
+ // or if I just put it here
+ }
void Unparse(const ArraySpec &x) { // R815
common::visit(
common::visitors{
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index ef7de1a35c1a2..de1010082a996 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -231,6 +231,7 @@ class ArraySpecAnalyzer {
ArraySpec arraySpec_;
template <typename T> void Analyze(const std::list<T> &list) {
+ printf("Calling Analyze for each item in list\n");
for (const auto &elem : list) {
Analyze(elem);
}
@@ -383,6 +384,7 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
}
common::visit(common::visitors{
[&](const parser::AssumedSizeSpec &y) {
+ printf("in ArraySpec, called lambda for AssumedSizeSpec &y\n");
Analyze(
std::get<std::list<parser::ExplicitShapeSpec>>(y.t));
Analyze(std::get<parser::AssumedImpliedSpec>(y.t));
@@ -584,6 +586,7 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) {
arraySpec_.push_back(ShapeSpec::MakeAssumedShape(GetBound(x.v)));
}
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
+ printf("called ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x)\n");
MakeExplicit(std::get<std::optional<parser::SpecificationExpr>>(x.t),
std::get<parser::SpecificationExpr>(x.t));
}
>From bde93f3e0204d76c45fdb14391f544d75e36b589 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 23 Feb 2026 11:40:02 -0600
Subject: [PATCH 29/32] It looks like this works at runtime (minimal testing).
Next, handle broadcasting case, and errors. I think this can all be done in
Semantics because of constness constraint.
---
flang/lib/Semantics/resolve-names-utils.cpp | 1 -
1 file changed, 1 deletion(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index de1010082a996..6f73853f63cee 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -384,7 +384,6 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
}
common::visit(common::visitors{
[&](const parser::AssumedSizeSpec &y) {
- printf("in ArraySpec, called lambda for AssumedSizeSpec &y\n");
Analyze(
std::get<std::list<parser::ExplicitShapeSpec>>(y.t));
Analyze(std::get<parser::AssumedImpliedSpec>(y.t));
>From ba1330d5d82513affd5f0bce75d33a054f909af5 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 24 Feb 2026 15:12:14 -0600
Subject: [PATCH 30/32] Add error for matching array sizes when two are
provided and non-parameter expressions
---
flang/lib/Semantics/resolve-names-utils.cpp | 3 +--
1 file changed, 1 insertion(+), 2 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 6f73853f63cee..17304857552fb 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -231,7 +231,6 @@ class ArraySpecAnalyzer {
ArraySpec arraySpec_;
template <typename T> void Analyze(const std::list<T> &list) {
- printf("Calling Analyze for each item in list\n");
for (const auto &elem : list) {
Analyze(elem);
}
@@ -585,7 +584,6 @@ void ArraySpecAnalyzer::Analyze(const parser::AssumedShapeSpec &x) {
arraySpec_.push_back(ShapeSpec::MakeAssumedShape(GetBound(x.v)));
}
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
- printf("called ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x)\n");
MakeExplicit(std::get<std::optional<parser::SpecificationExpr>>(x.t),
std::get<parser::SpecificationExpr>(x.t));
}
@@ -694,6 +692,7 @@ bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(
return true;
}
+
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
if (!checkExplicitShapeBoundsSpec(x)) {
arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
>From dad9a7382bbc0060143023446bae8fd3c9f939f4 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 24 Feb 2026 16:16:02 -0600
Subject: [PATCH 31/32] Add tests for wrong rank, as well as no-rewrite test
---
flang/lib/Semantics/resolve-names-utils.cpp | 8 ++++++++
1 file changed, 8 insertions(+)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 17304857552fb..621985f6df644 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -650,6 +650,14 @@ bool ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(
ubExpr->Rank());
rankError_ = true;
}
+ if(ubRank > 1) {
+ parser::CharBlock at{parser::FindSourceLocation(upperBound)};
+ context_.Say(at,
+ "Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-%d"_err_en_US, ubRank);
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ rankError_ = true;
+ }
+
int lbSize{0};
if (lowerBoundOpt) {
>From a03d8c35d1a1b66aacc2e29d917fca0b4b769e77 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 27 Feb 2026 17:42:27 -0600
Subject: [PATCH 32/32] Cleanup and refactor some code
---
flang/include/flang/Parser/parse-tree.h | 6 +-
flang/lib/Lower/Allocatable.cpp | 16 +-
flang/lib/Parser/unparse.cpp | 4 -
flang/lib/Semantics/check-allocate.cpp | 198 +++++++++++-------------
flang/lib/Semantics/expression.cpp | 71 +++------
5 files changed, 119 insertions(+), 176 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index dd17ef9db90df..d814e73cc4d24 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1940,10 +1940,10 @@ struct AllocateCoarraySpec {
// R933 allocation ->
// allocate-object [( allocate-shape-spec-list )]
+// [lbracket allocate-coarray-spec rbracket] |
+// allocate-object ( [ lower-bounds-expr : ] upper-bounds-expr )
+// [ lbracket allocate-coarray-spec rbracket ]
// [lbracket allocate-coarray-spec rbracket]
-// | allocate-object ( allocate-shape-spec-array )
-// [lbracket allocate-coarray-spec rbracket]
-// allocate-shape-spec-array -> [ lower-bounds-expr : ] upper-bounds-expr
struct AllocateShapeSpecArray {
TUPLE_CLASS_BOILERPLATE(AllocateShapeSpecArray);
std::tuple<
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index cee3290e7f995..1c3f7b5cd16c4 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -336,7 +336,6 @@ class AllocateStmtHelper {
const Fortran::semantics::Symbol &getSymbol() const {
return unwrapSymbol(getAllocObj());
}
- // Check if this allocation uses array bounds (F2023 feature)
bool hasArrayBounds() const {
const auto &shapeSpecArrayList{
std::get<Fortran::parser::AllocateShapeSpecArrayList>(alloc.t)};
@@ -412,10 +411,7 @@ class AllocateStmtHelper {
return true;
}
else {
- // For AllocateShapeSpecArray, check if the optional lower bound is present
const auto &shapeSpecArray{alloc.getShapeSpecArrays()};
- // std::get<0> gets the optional<IntExpr> for the lower bound
- // If it has a value, then lower bounds are not all ones
return !std::get<0>(shapeSpecArray.t).has_value();
}
}
@@ -463,19 +459,17 @@ class AllocateStmtHelper {
}
}
else {
- // Handle AllocateShapeSpecArray (F2023 array bounds feature)
+ // Handle AllocateShapeSpecArray
const auto &shapeSpecArray{alloc.getShapeSpecArrays()};
const auto &lowerOptBoundsExpr{std::get<0>(shapeSpecArray.t)};
const auto &upperBoundsExpr{std::get<1>(shapeSpecArray.t)};
- // Get the semantic expressions
const Fortran::lower::SomeExpr *ubExpr =
Fortran::semantics::GetExpr(upperBoundsExpr);
const Fortran::lower::SomeExpr *lbExpr =
lowerOptBoundsExpr ? Fortran::semantics::GetExpr(*lowerOptBoundsExpr)
: nullptr;
- // Determine ranks
int ubRank = ubExpr->Rank();
int lbRank = lbExpr ? lbExpr->Rank() : 0;
@@ -498,12 +492,10 @@ class AllocateStmtHelper {
}
}
}
- assert(extent > 0 && "bounds array must have known constant size");
// Prepare upper bounds
llvm::SmallVector<mlir::Value> ubValues;
if (ubRank == 1) {
- // Upper bounds is an array - extract each element
fir::ExtendedValue ubExv = converter.genExprAddr(loc, *ubExpr, stmtCtx);
mlir::Value ubBase = fir::getBase(ubExv);
auto ubRefTy = mlir::dyn_cast<fir::ReferenceType>(ubBase.getType());
@@ -520,7 +512,6 @@ class AllocateStmtHelper {
ubValues.push_back(ub);
}
} else {
- // Upper bounds is a scalar - broadcast to all dimensions
mlir::Value ubScalar = fir::getBase(
converter.genExprValue(loc, *ubExpr, stmtCtx));
ubScalar = builder.createConvert(loc, idxTy, ubScalar);
@@ -533,7 +524,6 @@ class AllocateStmtHelper {
llvm::SmallVector<mlir::Value> lbValues;
if (lbExpr) {
if (lbRank == 1) {
- // Lower bounds is an array - extract each element
fir::ExtendedValue lbExv = converter.genExprAddr(loc, *lbExpr, stmtCtx);
mlir::Value lbBase = fir::getBase(lbExv);
auto lbRefTy = mlir::dyn_cast<fir::ReferenceType>(lbBase.getType());
@@ -550,7 +540,6 @@ class AllocateStmtHelper {
lbValues.push_back(lb);
}
} else {
- // Lower bounds is a scalar - broadcast to all dimensions
mlir::Value lbScalar = fir::getBase(
converter.genExprValue(loc, *lbExpr, stmtCtx));
lbScalar = builder.createConvert(loc, idxTy, lbScalar);
@@ -564,13 +553,11 @@ class AllocateStmtHelper {
for (int64_t i = 0; i < extent; ++i) {
if (!lbValues.empty()) {
lbounds.emplace_back(lbValues[i]);
- // extent = ub - lb + 1
mlir::Value diff = mlir::arith::SubIOp::create(builder, loc,
ubValues[i], lbValues[i]);
extents.emplace_back(
mlir::arith::AddIOp::create(builder, loc, diff, one));
} else {
- // No lower bound - extent = upper bound (assumes lb = 1)
extents.emplace_back(ubValues[i]);
}
}
@@ -760,6 +747,7 @@ class AllocateStmtHelper {
}
}
else {
+ //TODO: can this code path be reached with AllocateShapeSpecArray?
printf("UNIMPLEMENTED 3\n");
}
}
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index f7d8ef43bffe9..ab20ac2a91728 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -567,10 +567,6 @@ class UnparseVisitor {
Walk(std::get<std::optional<SpecificationExpr>>(x.t), ":");
Walk(std::get<SpecificationExpr>(x.t));
}
- void Unparse(const ExplicitShapeBoundsSpec &x) {
- // TODO: don't remember if this was needed to compile
- // or if I just put it here
- }
void Unparse(const ArraySpec &x) { // R815
common::visit(
common::visitors{
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 8e46b9d1df8fa..cfbe16c760eed 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -59,8 +59,6 @@ class AllocationCheckerHelper {
bool RunCoarrayRelatedChecks(SemanticsContext &) const;
static bool IsArray(const parser::Allocation &allocation) {
- // At this point, tree should be rewritten, so we can query
- // the active variant in AllocationShapeSpecArrayList
const auto &allocateShapeSpecArrayList{std::get<parser::AllocateShapeSpecArrayList>(allocation.t)};
return std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u);
}
@@ -593,23 +591,21 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
if (rank_ > 0) {
if(!isArray && !hasAllocateShapeSpecList()) {
- if (!hasAllocateShapeSpecList()) {
- // C939
- if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
- context.Say(name_.source,
- "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US);
+ // C939
+ if (!(allocateInfo_.gotSource || allocateInfo_.gotMold)) {
+ context.Say(name_.source,
+ "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US);
+ return false;
+ } else {
+ if (allocateInfo_.sourceExprRank != rank_) {
+ context
+ .Say(name_.source,
+ "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US)
+ .Attach(allocateInfo_.sourceExprLoc.value(),
+ "Expression in %s has rank %d but allocatable object has rank %d"_en_US,
+ allocateInfo_.gotSource ? "SOURCE" : "MOLD",
+ allocateInfo_.sourceExprRank, rank_);
return false;
- } else {
- if (allocateInfo_.sourceExprRank != rank_) {
- context
- .Say(name_.source,
- "Arrays in ALLOCATE must have a shape specification or an expression of the same rank must appear in SOURCE or MOLD"_err_en_US)
- .Attach(allocateInfo_.sourceExprLoc.value(),
- "Expression in %s has rank %d but allocatable object has rank %d"_en_US,
- allocateInfo_.gotSource ? "SOURCE" : "MOLD",
- allocateInfo_.sourceExprRank, rank_);
- return false;
- }
}
}
} else {
@@ -674,99 +670,89 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
else {
const auto &allocateShapeSpecArrayList{
std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)};
- //TODO: change to get, remove if
- if (const auto *boundsArray{
- std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u)}) {
- const auto &lowerOptIntExpr{std::get<0>(boundsArray->t)};
- const auto &upperIntExpr{std::get<1>(boundsArray->t)};
-
- int64_t upperBoundsArraySize{-1};
- int64_t lowerBoundsArraySize{-1};
-
- // We can check both bounds and report multiple errors instead of returning immediately.
- bool flaggedNonConstSize{false}, flaggedRank{false};
- const auto *upperExpr{GetExpr(context, upperIntExpr)};
- const auto *lowerExpr{lowerOptIntExpr ? GetExpr(context, *lowerOptIntExpr) : nullptr};
-
- // Try to get size from upper bounds (always present)
- if (upperExpr) {
- if (upperExpr->Rank() == 1) {
- if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)}) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- upperBoundsArraySize = *extent;
- }
- else {
- context.Say(parser::FindSourceLocation(upperIntExpr),
- "Rank-1 integer array used as upper bounds in ALLOCATE must have constant size"_err_en_US);
- flaggedNonConstSize = true;
- }
- }
- }
- }
- else if(upperExpr->Rank() > 1) {
- context.Say(parser::FindSourceLocation(upperIntExpr),
- "Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, upperExpr->Rank());
- flaggedRank = true;
- }
- }
-
- if (lowerExpr) {
- if (lowerExpr->Rank() == 1) {
- if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- lowerBoundsArraySize = *extent;
- }
- else {
- context.Say(parser::FindSourceLocation(lowerOptIntExpr),
- "Rank-1 integer array used as lower bounds in ALLOCATE must have constant size"_err_en_US);
- flaggedNonConstSize = true;
- }
- }
- }
- } else if(lowerExpr->Rank() > 1) {
- context.Say(parser::FindSourceLocation(lowerOptIntExpr),
- "Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, lowerExpr->Rank());
- flaggedRank = true;
- }
- }
-
- // Errors after this don't make sense to check if the previous checks failed
- if(flaggedNonConstSize || flaggedRank) return false;
-
- if((lowerBoundsArraySize > 0) && (upperBoundsArraySize > 0) && lowerBoundsArraySize != upperBoundsArraySize) {
- parser::CharBlock at{parser::FindSourceLocation(*boundsArray)};
- context.Say(at, "ALLOCATE bounds integer rank-1 arrays must have the same size; "
- "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
- static_cast<std::intmax_t>(lowerBoundsArraySize),
- static_cast<std::intmax_t>(upperBoundsArraySize));
- return false;
- }
-
- if ((lowerBoundsArraySize == upperBoundsArraySize) && (upperBoundsArraySize > 0) && (upperBoundsArraySize != rank_)) {
- context.Say(name_.source,
- "ALLOCATE bounds integer rank-1 arrays have %jd elements but allocatable object '%s' has rank %d"_err_en_US,
- static_cast<std::intmax_t>(upperBoundsArraySize),
- name_.source,
- rank_);
- return false;
- }
- else if(upperBoundsArraySize > -1 && lowerBoundsArraySize == -1 && upperBoundsArraySize != rank_) {
+ const auto &boundsArray{
+ std::get<parser::AllocateShapeSpecArray>(allocateShapeSpecArrayList.u)};
+ const auto &lowerOptIntExpr{std::get<0>(boundsArray.t)};
+ const auto &upperIntExpr{std::get<1>(boundsArray.t)};
+
+ int64_t upperBoundsArraySize{-1};
+ int64_t lowerBoundsArraySize{-1};
+
+ // We can check both bounds and report multiple errors instead of returning immediately.
+ bool flaggedNonConstSize{false}, flaggedRank{false};
+ const auto *upperExpr{GetExpr(context, upperIntExpr)};
+ const auto *lowerExpr{lowerOptIntExpr ? GetExpr(context, *lowerOptIntExpr) : nullptr};
+
+ if (upperExpr && upperExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)};
+ shape && shape->size() == 1 && (*shape)[0] &&
+ evaluate::ToInt64(*(*shape)[0])) {
+ upperBoundsArraySize = *evaluate::ToInt64(*(*shape)[0]);
+ } else {
context.Say(parser::FindSourceLocation(upperIntExpr),
- "ALLOCATE upper bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
- static_cast<std::intmax_t>(upperBoundsArraySize),
- name_.source,
- rank_);
+ "Rank-1 integer array used as upper bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
}
- else if(lowerBoundsArraySize > -1 && upperBoundsArraySize == -1 && lowerBoundsArraySize != rank_) {
+ }
+ else if(upperExpr && upperExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, upperExpr->Rank());
+ flaggedRank = true;
+ }
+
+ if (lowerExpr && lowerExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)};
+ shape->size() == 1 && (*shape)[0] &&
+ evaluate::ToInt64(*(*shape)[0])) {
+ lowerBoundsArraySize = *evaluate::ToInt64(*(*shape)[0]);
+ } else {
context.Say(parser::FindSourceLocation(lowerOptIntExpr),
- "ALLOCATE lower bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
- static_cast<std::intmax_t>(lowerBoundsArraySize),
- name_.source,
- rank_);
+ "Rank-1 integer array used as lower bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
}
}
+ else if(lowerExpr && lowerExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, lowerExpr->Rank());
+ flaggedRank = true;
+ }
+
+ // Errors after this don't make sense to check if the previous checks failed
+ if(flaggedNonConstSize || flaggedRank) return false;
+
+ if((lowerBoundsArraySize > 0) && (upperBoundsArraySize > 0) && lowerBoundsArraySize != upperBoundsArraySize) {
+ parser::CharBlock at{parser::FindSourceLocation(boundsArray)};
+ context.Say(at, "ALLOCATE bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ static_cast<std::intmax_t>(upperBoundsArraySize));
+ return false;
+ }
+
+ if ((lowerBoundsArraySize == upperBoundsArraySize) && (upperBoundsArraySize > 0) && (upperBoundsArraySize != rank_)) {
+ context.Say(name_.source,
+ "ALLOCATE bounds integer rank-1 arrays have %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(upperBoundsArraySize),
+ name_.source,
+ rank_);
+ return false;
+ }
+ else if(upperBoundsArraySize > -1 && lowerBoundsArraySize == -1 && upperBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "ALLOCATE upper bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(upperBoundsArraySize),
+ name_.source,
+ rank_);
+ return false;
+ }
+ else if(lowerBoundsArraySize > -1 && upperBoundsArraySize == -1 && lowerBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "ALLOCATE lower bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ name_.source,
+ rank_);
+ return false;
+ }
}
}
} else { // allocating a scalar object
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 87dfa9fe193fd..df6de15cdc413 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4378,44 +4378,18 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
}
// Everything comes in as an
-// AllocateShapeSpecArrayList -> AllocateShapeSpecList at the root of the relevant tree,
-// with the assumption that it's a misparse if there is a rank-1 array in at least one of the
-// bounds. So correct the misparse by rewriting from
-// AllocateShapeSpecArrayList -> AllocateShapeSpecList to
-// AllocateShapeSpecArrayList -> AllocateShapeSpecArray.
+// AllocateShapeSpecArrayList -> std::list<AllocateShapeSpec>
+// with the assumption that it's a misparse if there is a rank > 1 array in at least one of the
+// bounds, and the original std::list<AllocateShapeSpec> is 1 element long.
+// So correct the misparse by rewriting from std::list<AllocateShapeSpec> to AllocateShapeSpecArray.
// This is necessary, otherwise semantic analysis will fail since AllocateShapeSpec contains
// a BoundExpr which is just a ScalarIntExpr. We need to place the expression(s) in an
// AllocateShapeSpecArray because that is typed as a pair of BoundsExpr, which is a
-// (more general) IntExpr. So it will still cover the case of having a scalar broadcast
+// (more general) IntExpr. It will still cover the case of having a scalar broadcast
// to a rank-1 integer array.
-// In short, if there is at least 1 rank-1 integer array, rewrite this part of the tree
-// to avoid the ScalarIntExpr semantic check and instead pass through the IntExpr semantic
-// check. Since we cannot clone nodes in a tree, we will handle both cases in Lower, both
-// cases being AllocateShapeSpecList and AllocateShapeSpecArray.
-
-// AllocateShapeSpecList isn't explicitly in the dump, but can be inferred from multiple AllocateShapeSpecs.
-// | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
-// | | | Allocation
-// | | | | AllocateObject -> Name = 'arr'
-// | | | | AllocateShapeSpecArrayList -> AllocateShapeSpec
-// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
-// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
-// | | | | AllocateShapeSpec
-// | | | | | Scalar -> Integer -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
-// | | ExecutionPartConstruct -> ExecutableConstruct -> ActionStmt -> AllocateStmt
-// | | | Allocation
-// | | | | AllocateObject -> Name = 'arr'
-// | | | | AllocateShapeSpecArrayList -> AllocateShapeSpec
-// | | | | | Scalar -> Integer -> Expr -> ArrayConstructor -> AcSpec
-// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '2'
-// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '1'
-// | | | | | Scalar -> Integer -> Expr -> ArrayConstructor -> AcSpec
-// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '3'
-// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
-// We can decide that a misparsed AllocateShapeSpecList is supposed to be
-// an AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
-// is an array (rank > 0). We will check that it is a rank-1 array
-// as part of other error checks in check-allocate.cpp.
+// Since we cannot clone nodes in a tree, we will handle both cases separately in Lower.
+// We will check that it is a rank-1 array as part of other error checks in
+// check-allocate.cpp, so rewrite even if rank != 1.
MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
@@ -4427,24 +4401,23 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
// Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
+ const auto *lowerBound = lowerBoundOpt ? &*lowerBoundOpt : nullptr;
+
bool foundArray{false};
// We want to rewrite as an AllocateShapeSpecArray even if
// the element type is wrong (say a real instead of integer), so
// analyze as an unwrapped Expr for its rank, then analyze as
// an Integer<Indirection<Expr>>.
- if(MaybeExpr analyzedExpr = Analyze(upperBound.thing.thing.value())) {
- if(analyzedExpr->Rank() > 0) {
- foundArray = true;
- Analyze(upperBound.thing);
- }
+ if(MaybeExpr analyzedExpr = Analyze(upperBound.thing.thing.value());
+ analyzedExpr && (analyzedExpr->Rank() > 0)) {
+ foundArray = true;
+ Analyze(upperBound.thing);
}
- if(lowerBoundOpt) {
- const auto &lowerBound{*lowerBoundOpt};
- if(MaybeExpr analyzedExpr = Analyze(lowerBound.thing.thing.value())) {
- if(analyzedExpr->Rank() > 0) {
- foundArray = true;
- Analyze(lowerBound.thing);
- }
+ if(lowerBound) {
+ if(MaybeExpr analyzedExpr = Analyze(lowerBound->thing.thing.value());
+ analyzedExpr && analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ Analyze(lowerBound->thing);
}
}
@@ -4455,8 +4428,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
// Handle optional lower bound
std::optional<parser::IntExpr> lowerIntExpr;
- if(lowerBoundOpt) {
- auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
+ if(lowerBound) {
+ auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBound)};
lowerIntExpr = std::move(mutableLowerBound.thing);
}
@@ -4470,7 +4443,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
}
}
-// Analyze each AllocateShapeSpec, as a Scalar<Int<Expr>>
+ // Analyze each AllocateShapeSpec, as a Scalar<Int<Expr>>
for(auto it = shapeSpecList.begin(); it != shapeSpecList.end(); ++it) {
const auto &upperBound{std::get<1>(it->t)};
Analyze(upperBound);
More information about the flang-commits
mailing list