[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
Wed Feb 25 08:14:34 PST 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/183193
>From dad4fdcbcc050c5fb5fd595fd23971bf19a22eaa 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 01/27] 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 84c7b8d2a5349..a6bb0e6d64901 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 4aec99c80bdae..32a12a04720c9 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1905,6 +1905,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 {
@@ -1921,14 +1925,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 4de20f5ea46a5..94a31ffdf2cd3 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 3d8ea9f703b2f..107385f0f3987 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -849,7 +849,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 0bb73ebe5b98f1565a3cc76885d66c80a97107e5 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 02/27] 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 94a31ffdf2cd3..ac1a653da5ad5 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 &);
@@ -502,6 +503,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 81603b8c20ce3..d85eedec4f8c2 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4361,6 +4361,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 251a1ca5ed2c13a588b17181851f574f1100f5d0 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 03/27] 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 d85eedec4f8c2..81c5d8094f9eb 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4383,11 +4383,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 =
@@ -4403,13 +4400,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 09033697b86f23135dc3425acb8cb6e94c6fb767 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 04/27] 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 81c5d8094f9eb..4a3a0546a19f5 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4371,29 +4371,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 2a50964598edb63cc5834782df65cb1a99f1fecc 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 05/27] 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 4a3a0546a19f5..7472b8a8cb468 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4361,17 +4361,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 a32c1a9be162f58f7785f1623f5ff77aa134814d 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 06/27] 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 7472b8a8cb468..9c582adde1bd2 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4424,7 +4424,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(
@@ -4505,12 +4506,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)};
@@ -4571,169 +4568,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 4ca0e3a4b15f86093cde4eb94ad10ef9be6f6ffc 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 07/27] 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 ac1a653da5ad5..c659f1e40a05e 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 &);
@@ -503,9 +503,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 9c582adde1bd2..015fec0269a7d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4503,70 +4503,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 36998b0b9f2a82bb4158c09cc4e6ba27b6b3746a 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 08/27] 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 97de18f71f0ab6df0ea74586f7b2d323751db868 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 09/27] 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 4fa179c68f7479f71740dc6a1134c2a87ecfb43b 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 10/27] 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 015fec0269a7d..f7ccd89c87520 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4553,7 +4553,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) {
@@ -4564,7 +4564,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 92709ba10e56235ac4c181c5abc3948247d6413a 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 11/27] 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 f7ccd89c87520..49c9e5ad81038 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4550,14 +4550,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;
+ }
+ }
+ }
}
}
@@ -4566,15 +4578,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 f829ef92698861d5eb0adf90b0c71cd17e8aed77 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 12/27] 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 6265295017bd4c9aad6e87f944aaeceae9e4d36f 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 13/27] 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 32a12a04720c9..7634aaafad83a 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1948,21 +1948,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 49c9e5ad81038..665d27a174e00 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4361,148 +4361,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
@@ -4539,9 +4397,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 b2a817a0b53dd896b8d115622943d0d9c322930b 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 14/27] 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 665d27a174e00..4affa78823f77 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4402,7 +4402,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;
}
@@ -4475,6 +4475,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 5ec283fe95025ed0620a34624d36ad195e7e4a4e 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 15/27] 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 4affa78823f77..60d34b8082479 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4452,11 +4452,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 58ddce1555de29cb60b5fd8d935cba2fd2b0f518 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 16/27] 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 b8a1c7ae99db113ec72417a2efae4b82fa396e05 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 17/27] 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 60d34b8082479..4b10dd3564a8a 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4398,7 +4398,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)};
@@ -4406,28 +4407,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
@@ -4435,30 +4422,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 df38235f3f4357fc8ab7f6ab23e517e8e800d9bf 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 18/27] 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 4b10dd3564a8a..6fd8657989f3d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4407,54 +4407,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 6b79ae486efbf68a663b439017eee3ef8cb3ba01 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 19/27] 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 d2a04859cd3a3d7dae0f6536ffe06e620e6c9ece 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 20/27] 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 7ac6c6853c81c309c5306bc8f7c44abd6632786f 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 21/27] 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/include/flang/Parser/dump-parse-tree.h | 1 +
flang/include/flang/Parser/parse-tree.h | 34 ++++++++++++--
flang/lib/Parser/unparse.cpp | 5 ++
flang/lib/Semantics/resolve-names-utils.cpp | 49 +++++++++++++++++++-
4 files changed, 84 insertions(+), 5 deletions(-)
diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h
index a6bb0e6d64901..d445584f99ca9 100644
--- a/flang/include/flang/Parser/dump-parse-tree.h
+++ b/flang/include/flang/Parser/dump-parse-tree.h
@@ -348,6 +348,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 7634aaafad83a..0bbc9d8c5ed55 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1327,11 +1327,39 @@ EMPTY_CLASS(AssumedRankSpec);
// explicit-shape-spec-list | assumed-shape-spec-list |
// deferred-shape-spec-list | assumed-size-spec | implied-shape-spec |
// implied-shape-or-assumed-size-spec | assumed-rank-spec
+// R814 array-spec is
+// explicit-shape-spec-list
+// or explicit-shape-bounds-spec
+// or assumed-shape-spec-list
+// or assumed-shape-bounds-spec
+// or deferred-shape-spec-list
+// or assumed-size-spec
+// or implied-shape-spec
+// or implied-shape-or-assumed-size-spec
+// or assumed-rank-spec
+// Combine first two rules:
+// eplicit-shape-spec-list-or-array
+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>
- u;
+ std::variant<
+ std::list<ExplicitShapeSpec>,
+ ExplicitShapeBoundsSpec,
+ std::list<AssumedShapeSpec>,
+ DeferredShapeSpecList,
+ AssumedSizeSpec,
+ ImpliedShapeSpec,
+ AssumedRankSpec>
+ u;
};
// R826 intent-spec -> IN | OUT | INOUT
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 107385f0f3987..26fabb724f9b1 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -567,10 +567,15 @@ 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{
[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
+ [&](const ExplicitShapeBoundsSpec &y) { Walk(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..294d79e07dfd3 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -197,12 +197,14 @@ 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);
}
}
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 &);
@@ -237,15 +239,54 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ComponentArraySpec &x) {
CHECK(!arraySpec_.empty());
return arraySpec_;
}
+
+static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
+ printf("called checkAndRewriteExplicitShapeSpecListToExplicitBounds\n");
+ if (!std::getenv("FLANG_DEBUG_BOUNDS")) return false;
+
+ // Cast away const to get mutable access to the parse tree
+ parser::ArraySpec &mutableArraySpec{const_cast<parser::ArraySpec&>(x)};
+ auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(mutableArraySpec.u)};
+ auto &explicitShapeSpec{explicitShapeSpecList.front()};
+ auto &upperSpecificationExpr{std::get<1>(explicitShapeSpec.t)};
+ auto &upperIntExpr{upperSpecificationExpr.v.thing};
+
+ std::optional<parser::ExplicitBoundsExpr> lowerExplicitBoundsExpr;
+ parser::ExplicitBoundsExpr upperExplicitBoundsExpr{std::move(upperIntExpr)};
+
+ parser::ExplicitShapeBoundsSpec boundsSpec{
+ std::make_tuple(
+ std::move(lowerExplicitBoundsExpr),
+ std::move(upperExplicitBoundsExpr)
+ )
+ };
+
+ // Now update the parse tree with the new bounds spec
+ mutableArraySpec.u = std::move(boundsSpec);
+ return true;
+}
+
ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
+ printf("Called ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x)\n");
+ if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u) &&
+ checkAndRewriteExplicitShapeSpecListToExplicitBounds(x)) {
+ printf("TODO: return value\n");
+ return arraySpec_;
+ }
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));
},
- [&](const parser::ImpliedShapeSpec &y) { Analyze(y.v); },
- [&](const auto &y) { Analyze(y); },
+ [&](const parser::ImpliedShapeSpec &y) {
+ printf("in ArraySpec, called lambda for ImpliedShapeSpec &y\n");
+ Analyze(y.v); },
+ [&](const auto &y) {
+ printf("in ArraySpec, called lambda for auto &y\n");
+ Analyze(y);
+ },
},
x.u);
CHECK(!arraySpec_.empty());
@@ -276,8 +317,12 @@ 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));
+}
+void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
+
}
void ArraySpecAnalyzer::Analyze(const parser::AssumedImpliedSpec &x) {
MakeImplied(x.v);
>From fa57cafe82604d876e3b6cd5963673897efa50cb Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 16 Feb 2026 19:16:30 -0600
Subject: [PATCH 22/27] Tighten the rewrite logic. Find a place to put the
semantic checks in, after figuring out why an access to something like this
causes a linker error: integer, dimension([1,1,1] : [5,5,5]) :: array print
*, array(2,2,2) array is erroneously being turned into a function call at
some point
---
flang/lib/Semantics/resolve-names-utils.cpp | 78 +++++++++++++++------
1 file changed, 57 insertions(+), 21 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 294d79e07dfd3..64fe6e2f953e1 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -240,36 +240,72 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ComponentArraySpec &x) {
return arraySpec_;
}
-static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(const parser::ArraySpec &x) {
- printf("called checkAndRewriteExplicitShapeSpecListToExplicitBounds\n");
+static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(
+ SemanticsContext &context, const parser::ArraySpec &x) {
if (!std::getenv("FLANG_DEBUG_BOUNDS")) return false;
- // Cast away const to get mutable access to the parse tree
- parser::ArraySpec &mutableArraySpec{const_cast<parser::ArraySpec&>(x)};
- auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(mutableArraySpec.u)};
- auto &explicitShapeSpec{explicitShapeSpecList.front()};
- auto &upperSpecificationExpr{std::get<1>(explicitShapeSpec.t)};
- auto &upperIntExpr{upperSpecificationExpr.v.thing};
+ auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
+ const_cast<parser::ArraySpec&>(x).u)};
+
+ if (explicitShapeSpecList.size() != 1) {
+ return false;
+ }
- std::optional<parser::ExplicitBoundsExpr> lowerExplicitBoundsExpr;
- parser::ExplicitBoundsExpr upperExplicitBoundsExpr{std::move(upperIntExpr)};
+ auto &explicitShapeSpec{explicitShapeSpecList.front()};
+ const auto &upperBound{std::get<1>(explicitShapeSpec.t)};
+ const auto &lowerBoundOpt{std::get<0>(explicitShapeSpec.t)};
- parser::ExplicitShapeBoundsSpec boundsSpec{
- std::make_tuple(
- std::move(lowerExplicitBoundsExpr),
- std::move(upperExplicitBoundsExpr)
- )
- };
-
- // Now update the parse tree with the new bounds spec
- mutableArraySpec.u = std::move(boundsSpec);
- return true;
+ bool foundArray{false};
+
+ // Check upper bound for rank > 0
+ if (MaybeExpr analyzedExpr = AnalyzeExpr(context, upperBound.v.thing.thing.value())) {
+ if (analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ }
+ }
+
+ // Check lower bound for rank > 0
+ if (lowerBoundOpt) {
+ const auto &lowerBound{*lowerBoundOpt};
+ if (MaybeExpr analyzedExpr = AnalyzeExpr(context, lowerBound.v.thing.thing.value())) {
+ if (analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ }
+ }
+ }
+
+ if (foundArray) {
+ // Get the IntExpr from the bounds
+ 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)};
+
+ // Handle optional lower bound
+ std::optional<parser::IntExpr> lowerIntExpr;
+ if (lowerBoundOpt) {
+ auto &mutableLowerBound{std::get<0>(mutableExplicitShapeSpec.t)};
+ if (mutableLowerBound) {
+ lowerIntExpr = std::move(mutableLowerBound->v.thing);
+ }
+ }
+
+ // Create the ExplicitShapeBoundsSpec and replace the variant
+ parser::ExplicitShapeBoundsSpec boundsSpec{
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ mutableArraySpec.u = std::move(boundsSpec);
+
+ return true;
+ }
+
+ return false;
}
ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
printf("Called ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x)\n");
if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u) &&
- checkAndRewriteExplicitShapeSpecListToExplicitBounds(x)) {
+ checkAndRewriteExplicitShapeSpecListToExplicitBounds(context_, x)) {
printf("TODO: return value\n");
return arraySpec_;
}
>From b7f4f78b454ca6b3cad9ac0a6b15b52c11a57ec0 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 23/27] 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/include/flang/Parser/parse-tree.h | 2 -
flang/lib/Semantics/resolve-names-utils.cpp | 77 ++++++++++++++++++---
2 files changed, 67 insertions(+), 12 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 0bbc9d8c5ed55..b224368dbc5fd 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1337,8 +1337,6 @@ EMPTY_CLASS(AssumedRankSpec);
// or implied-shape-spec
// or implied-shape-or-assumed-size-spec
// or assumed-rank-spec
-// Combine first two rules:
-// eplicit-shape-spec-list-or-array
using ExplicitBoundsExpr = IntExpr;
struct ExplicitShapeBoundsSpec {
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 64fe6e2f953e1..646b35737b286 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -293,7 +293,7 @@ static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(
// Create the ExplicitShapeBoundsSpec and replace the variant
parser::ExplicitShapeBoundsSpec boundsSpec{
- std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
mutableArraySpec.u = std::move(boundsSpec);
return true;
@@ -303,24 +303,18 @@ static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(
}
ArraySpec ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x) {
- printf("Called ArraySpecAnalyzer::Analyze(const parser::ArraySpec &x)\n");
- if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u) &&
- checkAndRewriteExplicitShapeSpecListToExplicitBounds(context_, x)) {
- printf("TODO: return value\n");
- return arraySpec_;
+ if(std::get_if<std::list<parser::ExplicitShapeSpec>>(&x.u)) {
+ checkAndRewriteExplicitShapeSpecListToExplicitBounds(context_, 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));
},
[&](const parser::ImpliedShapeSpec &y) {
- printf("in ArraySpec, called lambda for ImpliedShapeSpec &y\n");
Analyze(y.v); },
[&](const auto &y) {
- printf("in ArraySpec, called lambda for auto &y\n");
Analyze(y);
},
},
@@ -357,9 +351,72 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
MakeExplicit(std::get<std::optional<parser::SpecificationExpr>>(x.t),
std::get<parser::SpecificationExpr>(x.t));
}
+
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> {
+ std::vector<std::int64_t> values;
+ if (auto scalar{evaluate::ToInt64(folded)}) {
+ printf("this is a scalar, %d\n", scalar);
+ 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)}) {
+ printf("this is a rank-1 array, ");
+ for (auto it{constArray->values().begin()};
+ it != constArray->values().end(); ++it) {
+ printf("%d ", it->ToInt64());
+ values.push_back(it->ToInt64());
+ }
+ printf("\n");
+ }
+ },
+ someInt->u);
+ }
+ return values;
+ };
+
+ // Fold the upper bound array expression
+ 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;
+ }
+
+ // Fold the lower bound array expression if present
+ 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);
+ }
+ }
+
+ // Create one ShapeSpec per element
+ for (std::size_t i{0}; i < ubValues.size(); ++i) {
+ Bound lb{1};
+ if (i < lbValues.size()) {
+ lb = Bound{common::Clone(evaluate::ExtentExpr{lbValues[i]})};
+ }
+ Bound ub{common::Clone(evaluate::ExtentExpr{ubValues[i]})};
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(std::move(lb), std::move(ub)));
+ }
}
+
void ArraySpecAnalyzer::Analyze(const parser::AssumedImpliedSpec &x) {
MakeImplied(x.v);
}
>From 57dc900902bfb66e9d2680303a01ed4660916f00 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Tue, 24 Feb 2026 11:37:13 -0600
Subject: [PATCH 24/27] Handle broadcast
---
flang/lib/Semantics/resolve-names-utils.cpp | 20 ++++++++--
.../Semantics/declaration_array_bounds.f90 | 37 +++++++++++++++++++
2 files changed, 53 insertions(+), 4 deletions(-)
create mode 100644 flang/test/Semantics/declaration_array_bounds.f90
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 646b35737b286..a8e7f1c5b2b80 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -214,6 +214,7 @@ class ArraySpecAnalyzer {
void MakeDeferred(int);
Bound GetBound(const std::optional<parser::SpecificationExpr> &);
Bound GetBound(const parser::SpecificationExpr &);
+ void checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x);
};
ArraySpec AnalyzeArraySpec(
@@ -352,7 +353,15 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
std::get<parser::SpecificationExpr>(x.t));
}
+void ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x) {
+ printf("called new function checkExplicitShapeBoundsSpec\n");
+
+}
+
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
+ // TODO: reuse the work done when checking for semantic errors
+ checkExplicitShapeBoundsSpec(x);
+
const auto &lowerBoundOpt{std::get<0>(x.t)};
const auto &upperBound{std::get<1>(x.t)};
@@ -407,12 +416,15 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
}
// Create one ShapeSpec per element
- for (std::size_t i{0}; i < ubValues.size(); ++i) {
+ std::size_t numDims{std::max(ubValues.size(), lbValues.size())};
+ for (std::size_t i{0}; i < numDims; ++i) {
Bound lb{1};
- if (i < lbValues.size()) {
- lb = Bound{common::Clone(evaluate::ExtentExpr{lbValues[i]})};
+ if (!lbValues.empty()) {
+ std::size_t lbIdx{lbValues.size() == 1 ? 0 : i};
+ lb = Bound{common::Clone(evaluate::ExtentExpr{lbValues[lbIdx]})};
}
- Bound ub{common::Clone(evaluate::ExtentExpr{ubValues[i]})};
+ 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)));
}
}
diff --git a/flang/test/Semantics/declaration_array_bounds.f90 b/flang/test/Semantics/declaration_array_bounds.f90
new file mode 100644
index 0000000000000..59f2c45117e0d
--- /dev/null
+++ b/flang/test/Semantics/declaration_array_bounds.f90
@@ -0,0 +1,37 @@
+! RUN: export FLANG_DEBUG_BOUNDS=1 && %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)
+
+
+ ! Negative cases (erros expected)
+ ! integer :: rank1_array(3) = [5,5,5]
+ ! integer :: g(rank1_array)
+
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ ! integer :: h([1.2,2.2,3.2]:[1,2,3])
+
+ integer :: i([1,2,3]:[3,3])
+
+end program
\ No newline at end of file
>From 9902eaf7640ef2665b3e91a0e89b6f0fb3f47a21 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 25/27] Add error for matching array sizes when two are
provided and non-parameter expressions
---
flang/lib/Semantics/resolve-names-utils.cpp | 75 ++++++++++++++++++-
.../Semantics/declaration_array_bounds.f90 | 42 ++++++-----
2 files changed, 95 insertions(+), 22 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index a8e7f1c5b2b80..a8fcc8a0e9860 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -197,7 +197,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);
}
@@ -348,16 +347,84 @@ 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));
}
void ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShapeBoundsSpec &x) {
- printf("called new function checkExplicitShapeBoundsSpec\n");
-
+ const auto &lowerBoundOpt{std::get<0>(x.t)};
+ const auto &upperBound{std::get<1>(x.t)};
+
+ // Analyze and fold the upper bound expression
+ MaybeExpr ubExpr{AnalyzeExpr(context_, upperBound.thing)};
+ if (!ubExpr) {
+ return;
+ }
+ auto ubFolded{evaluate::Fold(context_.foldingContext(), std::move(*ubExpr))};
+ int ubRank{ubFolded.Rank()};
+
+ bool constError_{false};
+ // Check that upper bound is a constant expression if it's an array
+ if (ubRank > 0 && !evaluate::IsActuallyConstant(ubFolded)) {
+ parser::CharBlock at{parser::FindSourceLocation(upperBound)};
+ context_.Say(at,
+ "Array (upper) bound must be a constant expression"_err_en_US);
+ // Push a dummy extent so arraySpec_ won't be empty
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ // hadError_ = true;
+ constError_ = true;
+ }
+
+ // Analyze and fold the lower bound expression if present
+ 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();
+ // Check that lower bound is a constant expression if it's an array
+ if (lbRank > 0 && !evaluate::IsActuallyConstant(*lbFolded)) {
+ parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
+ context_.Say(at,
+ "Array (lower) bound must be a constant expression"_err_en_US);
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ constError_ = true;
+ }
+ }
+ }
+
+ if(constError_) return;
+
+ // Check: if both lower and upper bounds are arrays, they must have the same
+ // number of elements
+ if (lbRank > 0 && ubRank > 0) {
+ 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));
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ // hadError_ = true;
+ return;
+ }
+ }
+ }
+ }
}
+
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
// TODO: reuse the work done when checking for semantic errors
checkExplicitShapeBoundsSpec(x);
diff --git a/flang/test/Semantics/declaration_array_bounds.f90 b/flang/test/Semantics/declaration_array_bounds.f90
index 59f2c45117e0d..8872153ad0cdf 100644
--- a/flang/test/Semantics/declaration_array_bounds.f90
+++ b/flang/test/Semantics/declaration_array_bounds.f90
@@ -5,33 +5,39 @@ program declaration_array_bounds
! ---- Valid cases (no errors expected) ----
! Scalar bounds (baseline)
- ! integer :: a(10)
- ! integer :: b(2:10)
+ integer :: a(10)
+ integer :: b(2:10)
- ! ! Array upper bound only
- ! integer :: c([3, 4, 5])
+ ! Array upper bound only
+ integer :: c([3, 4, 5])
- ! ! Array lower and upper bounds, same size
- ! integer :: d([2, 3] : [10, 20])
+ ! Array lower and upper bounds, same size
+ integer :: d([2, 3] : [10, 20])
- ! ! Scalar lower, array upper
- ! integer :: e(2 : [10, 20])
+ ! Scalar lower, array upper
+ integer :: e(2 : [10, 20])
- ! ! Array lower, scalar upper
- ! integer :: f([2, 3] : 10)
+ ! 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)
+ ! 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]
- ! integer :: g(rank1_array)
+ ! ! 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])
-
+ 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])
end program
\ No newline at end of file
>From d27a05d68857a8c7fbfa0f73898dbe1f4780dab0 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 26/27] Add tests for wrong rank, as well as no-rewrite test
---
flang/lib/Semantics/resolve-names-utils.cpp | 24 +++++++++++++++----
.../Semantics/declaration_array_bounds.f90 | 20 ++++++++++++++++
2 files changed, 39 insertions(+), 5 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index a8fcc8a0e9860..0077c00ebdfb1 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -364,8 +364,9 @@ void ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShape
int ubRank{ubFolded.Rank()};
bool constError_{false};
+ bool rankError_{false};
// Check that upper bound is a constant expression if it's an array
- if (ubRank > 0 && !evaluate::IsActuallyConstant(ubFolded)) {
+ if (!evaluate::IsActuallyConstant(ubFolded)) {
parser::CharBlock at{parser::FindSourceLocation(upperBound)};
context_.Say(at,
"Array (upper) bound must be a constant expression"_err_en_US);
@@ -374,6 +375,14 @@ void ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShape
// hadError_ = true;
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);
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ rankError_ = true;
+ }
+
// Analyze and fold the lower bound expression if present
int lbRank{0};
@@ -384,17 +393,24 @@ void ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(const parser::ExplicitShape
lbFolded = evaluate::Fold(context_.foldingContext(), std::move(*lbExpr));
lbRank = lbFolded->Rank();
// Check that lower bound is a constant expression if it's an array
- if (lbRank > 0 && !evaluate::IsActuallyConstant(*lbFolded)) {
+ if (!evaluate::IsActuallyConstant(*lbFolded)) {
parser::CharBlock at{parser::FindSourceLocation(*lowerBoundOpt)};
context_.Say(at,
"Array (lower) bound must be a constant expression"_err_en_US);
arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
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);
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ rankError_ = true;
+ }
}
}
- if(constError_) return;
+ if(constError_ || rankError_) return;
// Check: if both lower and upper bounds are arrays, they must have the same
// number of elements
@@ -436,7 +452,6 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
auto extractValues = [&](SomeExpr &folded) -> std::vector<std::int64_t> {
std::vector<std::int64_t> values;
if (auto scalar{evaluate::ToInt64(folded)}) {
- printf("this is a scalar, %d\n", scalar);
values.push_back(*scalar);
} else if (const auto *someInt{
evaluate::UnwrapExpr<evaluate::Expr<evaluate::SomeInteger>>(
@@ -447,7 +462,6 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
if (const auto *constArray{
evaluate::UnwrapExpr<evaluate::Constant<typename T::Result>>(
kindExpr)}) {
- printf("this is a rank-1 array, ");
for (auto it{constArray->values().begin()};
it != constArray->values().end(); ++it) {
printf("%d ", it->ToInt64());
diff --git a/flang/test/Semantics/declaration_array_bounds.f90 b/flang/test/Semantics/declaration_array_bounds.f90
index 8872153ad0cdf..c1acd738cb3c1 100644
--- a/flang/test/Semantics/declaration_array_bounds.f90
+++ b/flang/test/Semantics/declaration_array_bounds.f90
@@ -40,4 +40,24 @@ program declaration_array_bounds
!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 339074b9925b572c4a49f6f7b740d0ce1b4df9c1 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 25 Feb 2026 10:13:57 -0600
Subject: [PATCH 27/27] Remove debug switch
---
flang/lib/Semantics/resolve-names-utils.cpp | 2 --
1 file changed, 2 deletions(-)
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 0077c00ebdfb1..ea8c58b7d654c 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -242,8 +242,6 @@ ArraySpec ArraySpecAnalyzer::Analyze(const parser::ComponentArraySpec &x) {
static bool checkAndRewriteExplicitShapeSpecListToExplicitBounds(
SemanticsContext &context, const parser::ArraySpec &x) {
- if (!std::getenv("FLANG_DEBUG_BOUNDS")) return false;
-
auto &explicitShapeSpecList{std::get<std::list<parser::ExplicitShapeSpec>>(
const_cast<parser::ArraySpec&>(x).u)};
More information about the flang-commits
mailing list