[flang-commits] [flang] [flang] Implement rank-1 integer array as bound expressions in ALLOCATE statements (PR #178089)
via flang-commits
flang-commits at lists.llvm.org
Fri Feb 6 12:03:57 PST 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/178089
>From d1734d0aa3e07d827c364e249c9d957f8f281e35 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/15] 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 f6e4cce241ad3..35dffbaa1beb8 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 6c1aace66275f..e560206f36327 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1900,6 +1900,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 {
@@ -1916,14 +1920,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 50f75b2304d95..2157196d46a4a 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 fb7a7ec8517f4..3b9eeabaab2c8 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -847,7 +847,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 b5c9aa7f13afff6425e2f7e33f38b90d2c04b4e7 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/15] 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 2157196d46a4a..c39262463d10f 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 &);
@@ -506,6 +507,10 @@ class ExprChecker {
AnalyzeAndNoteUses(x);
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 e07d2ccd4f16b..465a977693a2d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4364,6 +4364,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 675446291056156c0c94d87184ab807107b1db83 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/15] 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 465a977693a2d..dd2ca01b23331 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4386,11 +4386,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 =
@@ -4406,13 +4403,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 95fdc41c5acab6201b6e6c7fe54b141e04b954cc 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/15] 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 dd2ca01b23331..ace6709fa85e9 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4374,29 +4374,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 27dfb614596ae99be59fd104e64240b948fa4536 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/15] 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 ace6709fa85e9..5311b63d8b814 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4364,17 +4364,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 50b3722caeed8d7811cd14e7b192e1c10d886849 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/15] 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 5311b63d8b814..f94dc80780be0 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4427,7 +4427,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(
@@ -4508,12 +4509,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)};
@@ -4574,169 +4571,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 4462b666ed1e7abf3cee5b74a580da35919cd809 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/15] 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 c39262463d10f..a4376e040d8dd 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 &);
@@ -507,9 +507,9 @@ class ExprChecker {
AnalyzeAndNoteUses(x);
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 f94dc80780be0..014dc69bb2813 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4506,70 +4506,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 8dd11151e7c0a21e9e943239c9c6d51c29000da4 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/15] 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 afda7faa822288da725c300466ba519dcf436799 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/15] 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 c7d24aeaef5a2c7997d0e44935c28efd8697017c 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/15] 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 014dc69bb2813..73aca3e13ff43 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4556,7 +4556,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) {
@@ -4567,7 +4567,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 c849a0448e121ff8709a3b3e779fe69632887439 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/15] 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 73aca3e13ff43..c4968e5701656 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4553,14 +4553,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;
+ }
+ }
+ }
}
}
@@ -4569,15 +4581,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 6c821b8564714b98a4ad0a058bc543c5ecb1106e 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/15] 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 658dd8af6d437dbdcbd4f40ca9d049cee249c77e 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/15] 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 e560206f36327..3e20533a26391 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -1943,21 +1943,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 c4968e5701656..5b4d2b4086585 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4364,148 +4364,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
@@ -4542,9 +4400,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 70ed0fce5926db181775f4334e2e94d0cbab4c52 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/15] 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 5b4d2b4086585..d59d246f6af9e 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4405,7 +4405,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;
}
@@ -4478,6 +4478,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 c2458126335361ed857555a752921730b3bcbf3d 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/15] 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 d59d246f6af9e..401ba7b6fd06d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4455,11 +4455,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
More information about the flang-commits
mailing list