[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
Wed Feb 11 12:52:13 PST 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/178089
>From 63e99e604d00765821bbc44a200f26cdf693f764 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/20] 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 9b23c54e0cb10729c0ef2e5f88ff1f58e8d54e0c 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/20] 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 d0f03565dc80fbfaca5fcd76cba11d2f2e9121e7 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/20] 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 a2dd5510282d366b8b1d7d4c27225b65fd19b822 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/20] 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 231afd44f4e2df0eead52567b9a52bd2d5e71447 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/20] 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 4c33913b59b00188f089ea43668b6ba8f6f42bae 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/20] 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 6885f8aa31ba4cdb3c93cea3db6d119a64daa72c 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/20] 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 24e0c9d15d6b4fb21c3e714e14491b787a28fc42 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/20] 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 94114805ca6de5236f0c4554703842e9c0f848b5 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/20] 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 b8a7815234a375a1e94b055ae426a56c32689a4b 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/20] 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 eeb41ba25fccae421220b8d93053f246936cc43e 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/20] 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 57c720589af06f4d16c1deace85578bda000241a 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/20] 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 4f75653c71e6da2212a1acc6177118afbcc4d2da 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/20] 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 311c601e80b15d2132dff691da9d6a0d637db31a 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/20] 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 ab7c2f3b94bf3b47624f5264f4b5651577969060 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/20] 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
>From 26346d3ff20d085a1e0427705aefc4ba6ef13a5e Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Mon, 2 Feb 2026 15:28:28 -0600
Subject: [PATCH 16/20] Change variable name
---
flang/lib/Lower/Allocatable.cpp | 28 ++++++++++++++--------------
1 file changed, 14 insertions(+), 14 deletions(-)
diff --git a/flang/lib/Lower/Allocatable.cpp b/flang/lib/Lower/Allocatable.cpp
index f3412e3194945..cee3290e7f995 100644
--- a/flang/lib/Lower/Allocatable.cpp
+++ b/flang/lib/Lower/Allocatable.cpp
@@ -479,26 +479,26 @@ class AllocateStmtHelper {
int ubRank = ubExpr->Rank();
int lbRank = lbExpr ? lbExpr->Rank() : 0;
- // Get numDims from whichever bound is an array (at least one must be)
- int64_t numDims = -1;
+ // Get extent from whichever bound is an array (at least one must be)
+ int64_t extent = -1;
if (ubRank == 1) {
auto ubShape = Fortran::evaluate::GetShape(
converter.getFoldingContext(), *ubExpr);
- if (const auto &extent = (*ubShape)[0]) {
- if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
- numDims = *constExtent;
+ if (const auto &_extent = (*ubShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*_extent)) {
+ extent = *constExtent;
}
}
} else if (lbRank == 1) {
auto lbShape = Fortran::evaluate::GetShape(
converter.getFoldingContext(), *lbExpr);
- if (const auto &extent = (*lbShape)[0]) {
- if (auto constExtent = Fortran::evaluate::ToInt64(*extent)) {
- numDims = *constExtent;
+ if (const auto &_extent = (*lbShape)[0]) {
+ if (auto constExtent = Fortran::evaluate::ToInt64(*_extent)) {
+ extent = *constExtent;
}
}
}
- assert(numDims > 0 && "bounds array must have known constant size");
+ assert(extent > 0 && "bounds array must have known constant size");
// Prepare upper bounds
llvm::SmallVector<mlir::Value> ubValues;
@@ -511,7 +511,7 @@ class AllocateStmtHelper {
mlir::Type elemTy = ubSeqTy.getEleTy();
mlir::Type elemRefTy = builder.getRefType(elemTy);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
mlir::Value ubElemAddr = fir::CoordinateOp::create(builder,
loc, elemRefTy, ubBase, idx);
@@ -524,7 +524,7 @@ class AllocateStmtHelper {
mlir::Value ubScalar = fir::getBase(
converter.genExprValue(loc, *ubExpr, stmtCtx));
ubScalar = builder.createConvert(loc, idxTy, ubScalar);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
ubValues.push_back(ubScalar);
}
}
@@ -541,7 +541,7 @@ class AllocateStmtHelper {
mlir::Type elemTy = lbSeqTy.getEleTy();
mlir::Type elemRefTy = builder.getRefType(elemTy);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
mlir::Value idx = builder.createIntegerConstant(loc, idxTy, i);
mlir::Value lbElemAddr = fir::CoordinateOp::create(builder,
loc, elemRefTy, lbBase, idx);
@@ -554,14 +554,14 @@ class AllocateStmtHelper {
mlir::Value lbScalar = fir::getBase(
converter.genExprValue(loc, *lbExpr, stmtCtx));
lbScalar = builder.createConvert(loc, idxTy, lbScalar);
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
lbValues.push_back(lbScalar);
}
}
}
// Compute extents from bounds
- for (int64_t i = 0; i < numDims; ++i) {
+ for (int64_t i = 0; i < extent; ++i) {
if (!lbValues.empty()) {
lbounds.emplace_back(lbValues[i]);
// extent = ub - lb + 1
>From f5db29f51a1b149456447c54db6069fe65d139ab Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Fri, 6 Feb 2026 20:10:26 -0600
Subject: [PATCH 17/20] Move check from expression.cpp to check-semantics.cpp.
That is, expression.cpp should only determine if rewrite is necessary and do
the rewrite. For check-allocate.cpp, add constant size checks, rank-1 checks,
matching size check, and missing case size check for scalar broadcast +
rank-1 array
---
flang/lib/Semantics/check-allocate.cpp | 72 +++++++++++++++----
flang/lib/Semantics/expression.cpp | 42 ++---------
.../test/Semantics/allocate_array_bounds.f90 | 45 +++++++++---
3 files changed, 99 insertions(+), 60 deletions(-)
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index 5c031726f3da6..8e46b9d1df8fa 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -672,9 +672,9 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
}
}
else {
- // Array bounds specification - check that bounds array size matches object rank
const auto &allocateShapeSpecArrayList{
std::get<parser::AllocateShapeSpecArrayList>(allocation_.t)};
+ //TODO: change to get, remove if
if (const auto *boundsArray{
std::get_if<parser::AllocateShapeSpecArray>(&allocateShapeSpecArrayList.u)}) {
const auto &lowerOptIntExpr{std::get<0>(boundsArray->t)};
@@ -682,44 +682,90 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
int64_t upperBoundsArraySize{-1};
int64_t lowerBoundsArraySize{-1};
+
+ // We can check both bounds and report multiple errors instead of returning immediately.
+ bool flaggedNonConstSize{false}, flaggedRank{false};
+ const auto *upperExpr{GetExpr(context, upperIntExpr)};
+ const auto *lowerExpr{lowerOptIntExpr ? GetExpr(context, *lowerOptIntExpr) : nullptr};
// Try to get size from upper bounds (always present)
- if (const auto *upperExpr{GetExpr(context, upperIntExpr)}) {
+ if (upperExpr) {
if (upperExpr->Rank() == 1) {
if (auto shape{evaluate::GetShape(context.foldingContext(), *upperExpr)}) {
if (shape->size() == 1 && (*shape)[0]) {
if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
upperBoundsArraySize = *extent;
}
+ else {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "Rank-1 integer array used as upper bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
+ }
}
}
}
+ else if(upperExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, upperExpr->Rank());
+ flaggedRank = true;
+ }
}
- // If upper was scalar, try to get size from lower bounds
- if (lowerOptIntExpr) {
- if (const auto *lowerExpr{GetExpr(context, *lowerOptIntExpr)}) {
- if (lowerExpr->Rank() == 1) {
- if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
- lowerBoundsArraySize = *extent;
- }
+ if (lowerExpr) {
+ if (lowerExpr->Rank() == 1) {
+ if (auto shape{evaluate::GetShape(context.foldingContext(), *lowerExpr)}) {
+ if (shape->size() == 1 && (*shape)[0]) {
+ if (auto extent{evaluate::ToInt64(*(*shape)[0])}) {
+ lowerBoundsArraySize = *extent;
+ }
+ else {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "Rank-1 integer array used as lower bounds in ALLOCATE must have constant size"_err_en_US);
+ flaggedNonConstSize = true;
}
}
}
+ } else if(lowerExpr->Rank() > 1) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-%d"_err_en_US, lowerExpr->Rank());
+ flaggedRank = true;
}
}
+
+ // Errors after this don't make sense to check if the previous checks failed
+ if(flaggedNonConstSize || flaggedRank) return false;
+
+ if((lowerBoundsArraySize > 0) && (upperBoundsArraySize > 0) && lowerBoundsArraySize != upperBoundsArraySize) {
+ parser::CharBlock at{parser::FindSourceLocation(*boundsArray)};
+ context.Say(at, "ALLOCATE bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ static_cast<std::intmax_t>(upperBoundsArraySize));
+ return false;
+ }
- // Check if bounds array size matches the object's rank
if ((lowerBoundsArraySize == upperBoundsArraySize) && (upperBoundsArraySize > 0) && (upperBoundsArraySize != rank_)) {
context.Say(name_.source,
- "ALLOCATE bounds array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ "ALLOCATE bounds integer rank-1 arrays have %jd elements but allocatable object '%s' has rank %d"_err_en_US,
static_cast<std::intmax_t>(upperBoundsArraySize),
name_.source,
rank_);
return false;
}
+ else if(upperBoundsArraySize > -1 && lowerBoundsArraySize == -1 && upperBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(upperIntExpr),
+ "ALLOCATE upper bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(upperBoundsArraySize),
+ name_.source,
+ rank_);
+ }
+ else if(lowerBoundsArraySize > -1 && upperBoundsArraySize == -1 && lowerBoundsArraySize != rank_) {
+ context.Say(parser::FindSourceLocation(lowerOptIntExpr),
+ "ALLOCATE lower bounds integer rank-1 array has %jd elements but allocatable object '%s' has rank %d"_err_en_US,
+ static_cast<std::intmax_t>(lowerBoundsArraySize),
+ name_.source,
+ rank_);
+ }
}
}
}
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 401ba7b6fd06d..014a689f69b9d 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4401,7 +4401,8 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::PointerObject &x) {
// | | | | | | AcValue -> Expr -> LiteralConstant -> IntLiteralConstant = '4'
// We can decide that a misparsed AllocateShapeSpecList is supposed to be
// an AllocateShapeSpecArray if the list is 1 entry long AND either of the expressions
-// is a rank-1 array.
+// is an array (rank > 0). We will check that it is a rank-1 array
+// as part of other error checks in check-allocate.cpp.
MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &x) {
auto &shapeSpecList{
std::get<std::list<parser::AllocateShapeSpec>>(x.u)};
@@ -4409,28 +4410,14 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
return std::nullopt;
}
- bool foundArray = false;
- int64_t ubSize = -1;
- int64_t lbSize = -1;
- int ubRank = 0;
- int lbRank = 0;
+ bool foundArray{false};
// Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
const auto &upperBoundExpr{upperBound.thing};
if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
- ubRank = analyzedExpr->Rank();
- if(ubRank == 1) {
- foundArray = true;
- if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent = ToInt64(*(*shape)[0])) {
- ubSize = *extent;
- }
- }
- }
- }
+ foundArray = analyzedExpr->Rank() > 0;
}
// Check lower bound if it exists
@@ -4438,30 +4425,11 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
if(lowerBoundOpt) {
const auto &lowerBoundExpr{lowerBoundOpt->thing};
if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
- lbRank = analyzedExpr->Rank();
- if(lbRank == 1) {
- foundArray = true;
- if (auto shape = GetShape(GetFoldingContext(), *analyzedExpr)) {
- if (shape->size() == 1 && (*shape)[0]) {
- if (auto extent = ToInt64(*(*shape)[0])) {
- lbSize = *extent;
- }
- }
- }
- }
+ foundArray |= analyzedExpr->Rank() > 0;
}
}
if(foundArray) {
- // Check for size mismatch BEFORE the rewrite (when both are arrays)
- if (ubRank == 1 && lbRank == 1 && ubSize > 0 && lbSize > 0 && ubSize != lbSize) {
- parser::CharBlock at{parser::FindSourceLocation(upperBoundExpr)};
- Say(at, "ALLOCATE bounds arrays must have the same size; "
- "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
- static_cast<std::intmax_t>(lbSize),
- static_cast<std::intmax_t>(ubSize));
- }
-
// Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index b8f5a947652bb..9cd8638ad9038 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -6,21 +6,46 @@ program int_array_alloc_03
real, allocatable, dimension(:,:,:) :: test_array_03
integer :: lower(4), upper(4)
+ integer :: rank_2_array(3,3), rank_3_array(3,3,3)
- !ERROR: ALLOCATE bounds arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array_01([1,2,3]:[3,3]))
!ERROR: Must have INTEGER type, but is REAL(4)
allocate( test_array_02([1.2,2.2,3.2]:[1,2,3]))
- !ERROR: ALLOCATE bounds array has 4 elements but allocatable object 'test_array_03' has rank 3
+
+ !ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
+ allocate( test_array_01([1,2,3]:[3,3]))
+
+ !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array_03' has rank 3
allocate( test_array_03(lower:upper) )
+ !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array_03' has rank 3
+ allocate( test_array_03(7 : [1,2,3,4]))
+ !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array_03' has rank 3
+ allocate( test_array_03([1,2] : 7))
-! contains
-! subroutine tmp02(unknown_size, test_ptr_01)
-! real, allocatable, dimension(:,:,:), INTENT(OUT) :: test_ptr_01
-! integer, INTENT(IN) :: unknown_size
-! integer :: upper(unknown_size)
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03([1,2,4] : rank_3_array))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ allocate( test_array_03(rank_2_array : [1,2,4]))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03(rank_2_array : rank_3_array))
+ !ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
+ allocate( test_array_03(rank_2_array : 7))
+ !ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
+ allocate( test_array_03(7 : rank_3_array))
+
+ contains
+ subroutine tmp02(unknown_size, test_ptr_01)
+ real, allocatable, dimension(:,:,:), INTENT(OUT) :: test_ptr_01
+ integer, INTENT(IN) :: unknown_size
+ integer :: lower(unknown_size), upper(unknown_size)
-! allocate(test_ptr_01(upper))
-! end subroutine
+ !ERROR: Rank-1 integer array used as upper bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(upper))
+ !ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
+ !ERROR: Rank-1 integer array used as upper bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(lower : upper))
+ !ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
+ allocate(test_ptr_01(lower : 10))
+ end subroutine
end program
>From db833b33aaa3dd14d4a6a4f0e68d66b6aaa5e63b Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 11:29:18 -0600
Subject: [PATCH 18/20] Rewrite tree even if element type is wrong. This
prevents us from throwing false AllocateShapeSpecList size errors when
erroring on the type (because it prevented rewrite). Also, be more specific
by requiring rewrite to have size 1, otherwise we accept weird cases like
allocate([1,2,3], 1).
---
flang/lib/Semantics/expression.cpp | 92 ++++++++++---------
.../test/Semantics/allocate_array_bounds.f90 | 38 ++++----
2 files changed, 71 insertions(+), 59 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 014a689f69b9d..fd820ac1fc528 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4410,54 +4410,60 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::AllocateShapeSpecArrayList &
return std::nullopt;
}
- bool foundArray{false};
-
- // Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
- const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
- const auto &upperBoundExpr{upperBound.thing};
-
- if(MaybeExpr analyzedExpr = Analyze(upperBoundExpr)) {
- foundArray = analyzedExpr->Rank() > 0;
- }
-
- // Check lower bound if it exists
- const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
- if(lowerBoundOpt) {
- const auto &lowerBoundExpr{lowerBoundOpt->thing};
- if(MaybeExpr analyzedExpr = Analyze(lowerBoundExpr)) {
- foundArray |= analyzedExpr->Rank() > 0;
- }
- }
-
- if(foundArray) {
- // Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
- auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
- parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
-
- // Handle optional lower bound
- std::optional<parser::IntExpr> lowerIntExpr;
+ if(shapeSpecList.size() == 1) {
+ // Get upper bound - BoundExpr is Scalar<Integer<Indirection<Expr>>>
+ const auto &upperBound{std::get<1>(shapeSpecList.front().t)};
+ const auto &lowerBoundOpt = std::get<0>(shapeSpecList.front().t);
+ bool foundArray{false};
+ // We want to rewrite as an AllocateShapeSpecArray even if
+ // the element type is wrong (say a real instead of integer), so
+ // analyze as an unwrapped Expr for its rank, then analyze as
+ // an Integer<Indirection<Expr>>.
+ if(MaybeExpr analyzedExpr = Analyze(upperBound.thing.thing.value())) {
+ if(analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ Analyze(upperBound.thing);
+ }
+ }
if(lowerBoundOpt) {
- auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
- lowerIntExpr = std::move(mutableLowerBound.thing);
+ const auto &lowerBound{*lowerBoundOpt};
+ if(MaybeExpr analyzedExpr = Analyze(lowerBound.thing.thing.value())) {
+ if(analyzedExpr->Rank() > 0) {
+ foundArray = true;
+ Analyze(lowerBound.thing);
+ }
+ }
}
- // Create the AllocateShapeSpecArray and replace the variant
- parser::AllocateShapeSpecArray boundsExpr{
- std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
- auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
- mutableArrayList.u = std::move(boundsExpr);
- } else {
- // start from second entry and analyze each AllocateShapeSpec, since at this point
- // we know we're not an AllocateShapeSpecArray
- for(auto it = std::next(shapeSpecList.begin()); it != shapeSpecList.end(); ++it) {
- // Analyze upper bound (required)
- const auto &upperBound{std::get<1>(it->t)};
- Analyze(upperBound.thing);
- // Analyze lower bound if present
- const auto &lowerBoundOpt{std::get<0>(it->t)};
+ if(foundArray) {
+ // Get the IntExpr from the upper bound (BoundExpr.thing is the IntExpr)
+ auto &mutableUpperBound{const_cast<parser::BoundExpr&>(upperBound)};
+ parser::IntExpr upperIntExpr{std::move(mutableUpperBound.thing)};
+
+ // Handle optional lower bound
+ std::optional<parser::IntExpr> lowerIntExpr;
if(lowerBoundOpt) {
- Analyze(lowerBoundOpt->thing);
+ auto &mutableLowerBound{const_cast<parser::BoundExpr&>(*lowerBoundOpt)};
+ lowerIntExpr = std::move(mutableLowerBound.thing);
}
+
+ // Create the AllocateShapeSpecArray and replace the variant
+ parser::AllocateShapeSpecArray boundsExpr{
+ std::make_tuple(std::move(lowerIntExpr), std::move(upperIntExpr))};
+ auto &mutableArrayList{const_cast<parser::AllocateShapeSpecArrayList&>(x)};
+ mutableArrayList.u = std::move(boundsExpr);
+
+ return std::nullopt;
+ }
+ }
+
+// Analyze each AllocateShapeSpec, as a Scalar<Int<Expr>>
+ for(auto it = shapeSpecList.begin(); it != shapeSpecList.end(); ++it) {
+ const auto &upperBound{std::get<1>(it->t)};
+ Analyze(upperBound);
+ const auto &lowerBoundOpt{std::get<0>(it->t)};
+ if(lowerBoundOpt) {
+ Analyze(*lowerBoundOpt);
}
}
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index 9cd8638ad9038..fc132b7137a11 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -1,37 +1,43 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
program int_array_alloc_03
implicit none
- real, allocatable, dimension(:,:,:) :: test_array_01
- real, allocatable, dimension(:,:,:) :: test_array_02
- real, allocatable, dimension(:,:,:) :: test_array_03
+ real, allocatable, dimension(:,:,:) :: test_array
integer :: lower(4), upper(4)
integer :: rank_2_array(3,3), rank_3_array(3,3,3)
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array_02([1.2,2.2,3.2]:[1,2,3]))
+ allocate( test_array([1.2,2.2,3.2]:[1,2,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array_01([1,2,3]:[3,3]))
+ allocate( test_array([1,2,3]:[3,3]))
- !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03(lower:upper) )
- !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03(7 : [1,2,3,4]))
- !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array_03' has rank 3
- allocate( test_array_03([1,2] : 7))
+ !ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array(lower:upper) )
+ !ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array(7 : [1,2,3,4]))
+ !ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array' has rank 3
+ allocate( test_array([1,2] : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03([1,2,4] : rank_3_array))
+ allocate( test_array([1,2,4] : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array_03(rank_2_array : [1,2,4]))
+ allocate( test_array(rank_2_array : [1,2,4]))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03(rank_2_array : rank_3_array))
+ allocate( test_array(rank_2_array : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array_03(rank_2_array : 7))
+ allocate( test_array(rank_2_array : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array_03(7 : rank_3_array))
+ allocate( test_array(7 : rank_3_array))
+
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten, giving error messages expecting scalar integers
+ ! and same number of aruments as rank of test_array
+ !ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ !ERROR: Must be a scalar value, but is a rank-1 array
+ allocate( test_array([1,2] : [2,3], 3, [1,2,3], 5))
contains
subroutine tmp02(unknown_size, test_ptr_01)
>From e3a4f59176a2a2e1743ca9552a6b60c79c00bdc3 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 14:32:43 -0600
Subject: [PATCH 19/20] Add test to ensure we don't allow cases where first
comma item fits the AllocateShapeSpecArray case
---
flang/test/Semantics/allocate_array_bounds.f90 | 8 +++++---
1 file changed, 5 insertions(+), 3 deletions(-)
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index fc132b7137a11..16f727049ab25 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -31,13 +31,15 @@ program int_array_alloc_03
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
allocate( test_array(7 : rank_3_array))
- ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten, giving error messages expecting scalar integers
- ! and same number of aruments as rank of test_array
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten,
+ ! giving error messages expecting same number of
+ ! aruments as rank of test_array and scalar integers
!ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
- allocate( test_array([1,2] : [2,3], 3, [1,2,3], 5))
+ !ERROR: Must have INTEGER type, but is REAL(4)
+ allocate( test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
contains
subroutine tmp02(unknown_size, test_ptr_01)
>From c81402b612bb0c3a444d07007d7c46079039ea1d Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 11 Feb 2026 14:51:45 -0600
Subject: [PATCH 20/20] Add positive test cases
---
.../test/Semantics/allocate_array_bounds.f90 | 51 ++++++++++++++-----
1 file changed, 38 insertions(+), 13 deletions(-)
diff --git a/flang/test/Semantics/allocate_array_bounds.f90 b/flang/test/Semantics/allocate_array_bounds.f90
index 16f727049ab25..634a69699ff94 100644
--- a/flang/test/Semantics/allocate_array_bounds.f90
+++ b/flang/test/Semantics/allocate_array_bounds.f90
@@ -1,45 +1,65 @@
! RUN: %python %S/test_errors.py %s %flang_fc1
program int_array_alloc_03
implicit none
+ real, allocatable, dimension(:) :: rank1_test_array
real, allocatable, dimension(:,:,:) :: test_array
+ integer :: seven = 7
+ integer :: valid_lower(3) = [1,1,1]
integer :: lower(4), upper(4)
integer :: rank_2_array(3,3), rank_3_array(3,3,3)
+ ! Positive test cases, expecting no errors
+ ! Test direct use of scalar integer and array integer expressions
+ allocate(rank1_test_array([5]))
+ allocate(rank1_test_array([1]:[5]))
+ allocate(rank1_test_array(1:[5]))
+ allocate(rank1_test_array([1]:5))
+
+ ! Test indirect use of scalar integer and array integer expressions
+ ! array : array
+ allocate(test_array([1,2,3] : [1,2,3] + 1))
+ ! array : array
+ allocate(test_array(valid_lower - 1 : seven * (valid_lower + seven)))
+ ! array : scalar (broadcast)
+ allocate(test_array(valid_lower : return_seven()))
+ ! scalar : array (broadcast)
+ allocate(test_array(seven : [9,9,9]))
+ !Negative test cases, expecting errors
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array([1.2,2.2,3.2]:[1,2,3]))
+ allocate(test_array([1.2,2.2,3.2]:[1,2,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- allocate( test_array([1,2,3]:[3,3]))
+ allocate(test_array([1,2,3]:[3,3]))
!ERROR: ALLOCATE bounds integer rank-1 arrays have 4 elements but allocatable object 'test_array' has rank 3
- allocate( test_array(lower:upper) )
+ allocate(test_array(lower:upper))
!ERROR: ALLOCATE upper bounds integer rank-1 array has 4 elements but allocatable object 'test_array' has rank 3
- allocate( test_array(7 : [1,2,3,4]))
+ allocate(test_array(7 : [1,2,3,4]))
!ERROR: ALLOCATE lower bounds integer rank-1 array has 2 elements but allocatable object 'test_array' has rank 3
- allocate( test_array([1,2] : 7))
+ allocate(test_array([1,2] : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array([1,2,4] : rank_3_array))
+ allocate(test_array([1,2,4] : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array(rank_2_array : [1,2,4]))
+ allocate(test_array(rank_2_array : [1,2,4]))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array(rank_2_array : rank_3_array))
+ allocate(test_array(rank_2_array : rank_3_array))
!ERROR: Integer array used as lower bounds in ALLOCATE must be rank-1 but is rank-2
- allocate( test_array(rank_2_array : 7))
+ allocate(test_array(rank_2_array : 7))
!ERROR: Integer array used as upper bounds in ALLOCATE must be rank-1 but is rank-3
- allocate( test_array(7 : rank_3_array))
+ allocate(test_array(7 : rank_3_array))
- ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten,
- ! giving error messages expecting same number of
+ ! Test that any comma list is parsed as AllocateShapeSpecList and not rewritten
+ ! to AllocateShapeSpecArray, giving error messages expecting same number of
! aruments as rank of test_array and scalar integers
!ERROR: The number of shape specifications, when they appear, must match the rank of allocatable object
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must be a scalar value, but is a rank-1 array
!ERROR: Must have INTEGER type, but is REAL(4)
- allocate( test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
+ allocate(test_array([1,2,3] : [2,3,4], 3, [1,2,3], 5.2))
contains
subroutine tmp02(unknown_size, test_ptr_01)
@@ -55,5 +75,10 @@ subroutine tmp02(unknown_size, test_ptr_01)
!ERROR: Rank-1 integer array used as lower bounds in ALLOCATE must have constant size
allocate(test_ptr_01(lower : 10))
end subroutine
+
+ function return_seven()
+ integer :: return_seven
+ return_seven = 7
+ end function
end program
More information about the flang-commits
mailing list