[flang-commits] [flang] [flang][semantic] Implement semantic checks and new data structure (PR #203030)
via flang-commits
flang-commits at lists.llvm.org
Wed Jun 10 11:47:22 PDT 2026
https://github.com/ivanrodriguez3753 updated https://github.com/llvm/llvm-project/pull/203030
>From f469c64d200b3c2befc282ba6b7ca1211e6d99a6 Mon Sep 17 00:00:00 2001
From: Ivan Rodriguez <ivan.rodriguez at hpe.com>
Date: Wed, 10 Jun 2026 12:19:57 -0500
Subject: [PATCH] [flang][semantic] Implement semantic checks and new data
structure that scalarizes rank-1 integer array bounds.
Since Lower and large parts of Semantics depend on ShapeSpec being a scalar bound, implement a class RankOneBoundElement that does just this. Since there is no syntactic representation for this node kind, have both unparse.cpp and mod-file.cpp emit the original rank-1 integer array expression instead of scalarized versions.
Analyze does semantic checks, then repackages into an array of scalarized ShapeSpec pairs instead of a pair of arrays.
Lower implementation in follow-up stack PR.
---
flang/include/flang/Evaluate/expression.h | 5 +-
flang/include/flang/Evaluate/shape.h | 1 +
flang/include/flang/Evaluate/traverse.h | 3 +
flang/include/flang/Evaluate/variable.h | 28 ++++
flang/include/flang/Semantics/dump-expr.h | 1 +
flang/lib/Evaluate/check-expression.cpp | 13 ++
flang/lib/Evaluate/fold-implementation.h | 2 +
flang/lib/Evaluate/fold-integer.cpp | 14 ++
flang/lib/Evaluate/formatting.cpp | 5 +
flang/lib/Evaluate/variable.cpp | 3 +
flang/lib/Lower/ConvertExpr.cpp | 9 ++
flang/lib/Lower/ConvertExprToHLFIR.cpp | 5 +
flang/lib/Lower/IterationSpace.cpp | 1 +
flang/lib/Lower/Support/Utils.cpp | 9 ++
flang/lib/Parser/unparse.cpp | 4 +-
flang/lib/Semantics/dump-expr.cpp | 6 +
flang/lib/Semantics/mod-file.cpp | 60 +++++++-
flang/lib/Semantics/resolve-names-utils.cpp | 142 +++++++++++++++++-
.../declaration-explicit-array-bounds.f90 | 88 +++++++----
.../modfile-explicit-shape-bounds.f90 | 52 +++++++
.../unparse-explicit-array-bounds.f90 | 42 ++++++
21 files changed, 449 insertions(+), 44 deletions(-)
create mode 100644 flang/test/Semantics/modfile-explicit-shape-bounds.f90
create mode 100644 flang/test/Semantics/unparse-explicit-array-bounds.f90
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 1afe8ae74c415..2df16d9a174a6 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -586,12 +586,15 @@ class Expr<Type<TypeCategory::Integer, KIND>>
using DescriptorInquiries =
std::conditional_t<KIND == DescriptorInquiry::Result::kind,
std::tuple<DescriptorInquiry>, std::tuple<>>;
+ using RankOneBoundElements =
+ std::conditional_t<KIND == RankOneBoundElement::Result::kind,
+ std::tuple<RankOneBoundElement>, std::tuple<>>;
using Others = std::tuple<Constant<Result>, ArrayConstructor<Result>,
Designator<Result>, FunctionRef<Result>>;
public:
common::TupleToVariant<common::CombineTuples<Operations, Conversions, Indices,
- TypeParamInquiries, DescriptorInquiries, Others>>
+ TypeParamInquiries, DescriptorInquiries, RankOneBoundElements, Others>>
u;
};
diff --git a/flang/include/flang/Evaluate/shape.h b/flang/include/flang/Evaluate/shape.h
index e5c2d6e8cb63d..e0148ef97a58d 100644
--- a/flang/include/flang/Evaluate/shape.h
+++ b/flang/include/flang/Evaluate/shape.h
@@ -165,6 +165,7 @@ class GetShapeHelper
Result operator()(const ImpliedDoIndex &) const { return ScalarShape(); }
Result operator()(const DescriptorInquiry &) const { return ScalarShape(); }
+ Result operator()(const RankOneBoundElement &) const { return ScalarShape(); }
Result operator()(const TypeParamInquiry &) const { return ScalarShape(); }
Result operator()(const BOZLiteralConstant &) const { return ScalarShape(); }
Result operator()(const StaticDataObject::Pointer &) const {
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index 44cfaa2a7073d..2cf33201b1409 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -161,6 +161,9 @@ class Traverse {
Result operator()(const DescriptorInquiry &x) const {
return visitor_(x.base());
}
+ Result operator()(const RankOneBoundElement &x) const {
+ return visitor_(x.base());
+ }
// Calls
Result operator()(const SpecificIntrinsic &) const {
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index 4f64ede3d407d..f510873ec2fe2 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -435,6 +435,34 @@ class DescriptorInquiry {
int dimension_{0}; // zero-based
};
+// Represents the extraction of a single scalar element from a rank-1
+// integer array expression used as an explicit-shape array bound (F2023).
+// The inner expression is rank-1; this node is scalar (Rank() == 0).
+// dimension_ is zero-based.
+class RankOneBoundElement {
+public:
+ using Result = SubscriptInteger;
+ CLASS_BOILERPLATE(RankOneBoundElement)
+ RankOneBoundElement(
+ common::CopyableIndirection<Expr<SubscriptInteger>> &&e, int dim)
+ : base_{std::move(e)}, dimension_{dim} {}
+ RankOneBoundElement(Expr<SubscriptInteger> &&e, int dim)
+ : base_{std::move(e)}, dimension_{dim} {}
+
+ const Expr<SubscriptInteger> &base() const { return base_.value(); }
+ Expr<SubscriptInteger> &base() { return base_.value(); }
+ int dimension() const { return dimension_; }
+
+ static constexpr int Rank() { return 0; } // always scalar
+ static constexpr int Corank() { return 0; }
+ bool operator==(const RankOneBoundElement &) const;
+ llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+
+private:
+ common::CopyableIndirection<Expr<SubscriptInteger>> base_;
+ int dimension_{0}; // zero-based
+};
+
#define INSTANTIATE_VARIABLE_TEMPLATES \
FOR_EACH_SPECIFIC_TYPE(template class Designator, )
} // namespace Fortran::evaluate
diff --git a/flang/include/flang/Semantics/dump-expr.h b/flang/include/flang/Semantics/dump-expr.h
index d79a294258ff1..868b64c64e60a 100644
--- a/flang/include/flang/Semantics/dump-expr.h
+++ b/flang/include/flang/Semantics/dump-expr.h
@@ -149,6 +149,7 @@ class DumpEvaluateExpr {
Outdent();
}
void Show(const evaluate::DescriptorInquiry &x);
+ void Show(const evaluate::RankOneBoundElement &x);
void Show(const evaluate::SpecificIntrinsic &);
void Show(const evaluate::ProcedureDesignator &x);
void Show(const evaluate::ActualArgument &x);
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index 62c93e5d20737..737502a504d61 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -91,6 +91,9 @@ class IsConstantExprHelper
(IsIntentIn(sym) && !IsOptional(sym) &&
!sym.attrs().test(semantics::Attr::VALUE)));
}
+ bool operator()(const RankOneBoundElement &x) const {
+ return (*this)(x.base());
+ }
bool operator()(const ImpliedDoIndex &ido) const {
return acImpliedDos_.find(ido.name) != acImpliedDos_.end() || !context_ ||
@@ -363,6 +366,9 @@ class IsInitialDataTargetHelper
IsConstantExpr(x.upper(), context_) && (*this)(x.parent());
}
bool operator()(const DescriptorInquiry &) const { return false; }
+ bool operator()(const RankOneBoundElement &x) const {
+ return false;
+ } // unreachable
template <typename T> bool operator()(const ArrayConstructor<T> &) const {
return false;
}
@@ -798,6 +804,10 @@ class CheckSpecificationExprHelper
}
}
+ Result operator()(const RankOneBoundElement &x) const {
+ return (*this)(x.base());
+ }
+
Result operator()(const TypeParamInquiry &inq) const {
if (scope_.IsDerivedType()) {
if (!IsConstantExpr(inq, &context_) &&
@@ -1797,6 +1807,9 @@ class CollectUsedSymbolValuesHelper
Result operator()(const DescriptorInquiry &) const {
return {}; // doesn't count as a use
}
+ Result operator()(const RankOneBoundElement &x) const {
+ return {}; // unreachable
+ }
template <typename T> Result operator()(const ConditionalExpr<T> &condExpr) {
auto restorer{common::ScopedSet(isDefinition_, false)};
diff --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 2df2b9e5a300b..5e7e85d33a92f 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -138,6 +138,8 @@ Expr<T> FoldOperation(FoldingContext &context, Designator<T> &&designator) {
}
Expr<TypeParamInquiry::Result> FoldOperation(
FoldingContext &, TypeParamInquiry &&);
+Expr<RankOneBoundElement::Result> FoldOperation(
+ FoldingContext &, RankOneBoundElement &&);
Expr<ImpliedDoIndex::Result> FoldOperation(
FoldingContext &context, ImpliedDoIndex &&);
template <typename T>
diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp
index 9f2bb94a9213f..bfecf5917f178 100644
--- a/flang/lib/Evaluate/fold-integer.cpp
+++ b/flang/lib/Evaluate/fold-integer.cpp
@@ -1554,6 +1554,20 @@ Expr<TypeParamInquiry::Result> FoldOperation(
return AsExpr(std::move(inquiry));
}
+Expr<RankOneBoundElement::Result> FoldOperation(
+ FoldingContext &context, RankOneBoundElement &&x) {
+ using ResultType = RankOneBoundElement::Result;
+ auto folded{Fold(context, Expr<ResultType>{x.base()})};
+ if (auto *c{UnwrapConstantValue<ResultType>(folded)}) {
+ // Base is a constant array; extract the element at dimension_ (0-based).
+ ConstantSubscripts at{c->lbounds()};
+ at[0] = c->lbounds()[0] + x.dimension();
+ return Expr<ResultType>{Constant<ResultType>{c->At(at)}};
+ }
+ return Expr<ResultType>{
+ RankOneBoundElement{std::move(folded), x.dimension()}};
+}
+
std::optional<std::int64_t> ToInt64(const Expr<SomeInteger> &expr) {
return common::visit(
[](const auto &kindExpr) { return ToInt64(kindExpr); }, expr.u);
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 3604484254196..5cd8af4fa9019 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -853,6 +853,11 @@ llvm::raw_ostream &DescriptorInquiry::AsFortran(llvm::raw_ostream &o) const {
return o << ",kind=" << DescriptorInquiry::Result::kind << ")";
}
+llvm::raw_ostream &RankOneBoundElement::AsFortran(llvm::raw_ostream &o) const {
+ llvm_unreachable("RankOneBoundElement has no Fortran representation");
+ return o;
+}
+
llvm::raw_ostream &Assignment::AsFortran(llvm::raw_ostream &o) const {
common::visit(
common::visitors{
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index b257dad42fc58..b5774ef9fe624 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -764,6 +764,9 @@ bool DescriptorInquiry::operator==(const DescriptorInquiry &that) const {
return field_ == that.field_ && base_ == that.base_ &&
dimension_ == that.dimension_;
}
+bool RankOneBoundElement::operator==(const RankOneBoundElement &that) const {
+ return dimension_ == that.dimension_ && base_ == that.base_;
+}
#ifdef _MSC_VER // disable bogus warning about missing definitions
#pragma warning(disable : 4661)
diff --git a/flang/lib/Lower/ConvertExpr.cpp b/flang/lib/Lower/ConvertExpr.cpp
index 32cd710e9b5b4..fded2bb9678a1 100644
--- a/flang/lib/Lower/ConvertExpr.cpp
+++ b/flang/lib/Lower/ConvertExpr.cpp
@@ -1062,6 +1062,10 @@ class ScalarExprLowering {
llvm_unreachable("unknown descriptor inquiry");
}
+ ExtValue genval(const Fortran::evaluate::RankOneBoundElement &) {
+ llvm_unreachable("RankOneBoundElement in legacy lowering path");
+ }
+
ExtValue genval(const Fortran::evaluate::TypeParamInquiry &) {
TODO(getLoc(), "type parameter inquiry");
}
@@ -6568,6 +6572,11 @@ class ArrayExprLowering {
TODO(getLoc(), "array expr descriptor inquiry");
return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };
}
+ CC genarr(const Fortran::evaluate::RankOneBoundElement &x) {
+ fir::emitFatalError(getLoc(),
+ "rank-1 bound element cannot appear in array context");
+ return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };
+ }
CC genarr(const Fortran::evaluate::StructureConstructor &x) {
TODO(getLoc(), "structure constructor");
return [](IterSpace iters) -> ExtValue { return mlir::Value{}; };
diff --git a/flang/lib/Lower/ConvertExprToHLFIR.cpp b/flang/lib/Lower/ConvertExprToHLFIR.cpp
index ad680269dea5c..56a1f59b87c34 100644
--- a/flang/lib/Lower/ConvertExprToHLFIR.cpp
+++ b/flang/lib/Lower/ConvertExprToHLFIR.cpp
@@ -1810,6 +1810,11 @@ class HlfirBuilder {
llvm_unreachable("unknown descriptor inquiry");
}
+ hlfir::EntityWithAttributes
+ gen(const Fortran::evaluate::RankOneBoundElement &x) {
+ TODO(getLoc(), "rank-1 bound element lowering");
+ }
+
/// Build nested if-then-else chain by walking the right-skewed
/// ConditionalExpr tree. The assignValue callback generates and assigns
/// each value to avoid evaluating non-taken branches.
diff --git a/flang/lib/Lower/IterationSpace.cpp b/flang/lib/Lower/IterationSpace.cpp
index 52a15223bc1e6..4b085e6eed784 100644
--- a/flang/lib/Lower/IterationSpace.cpp
+++ b/flang/lib/Lower/IterationSpace.cpp
@@ -166,6 +166,7 @@ class ArrayBaseFinder {
return find(x.u);
}
RT find(const Fortran::evaluate::DescriptorInquiry &) { return {}; }
+ RT find(const Fortran::evaluate::RankOneBoundElement &) { return {}; }
RT find(const Fortran::evaluate::SpecificIntrinsic &) { return {}; }
RT find(const Fortran::evaluate::ProcedureDesignator &x) { return {}; }
RT find(const Fortran::evaluate::ProcedureRef &x) {
diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp
index 6d38e1ff550a4..5f3be2f1783fd 100644
--- a/flang/lib/Lower/Support/Utils.cpp
+++ b/flang/lib/Lower/Support/Utils.cpp
@@ -243,6 +243,11 @@ class HashEvaluateExpr {
static_cast<unsigned>(x.dimension());
}
static unsigned
+ getHashValue(const Fortran::evaluate::RankOneBoundElement &x) {
+ return getHashValue(x.base()) * 141u +
+ static_cast<unsigned>(x.dimension()) * 17u;
+ }
+ static unsigned
getHashValue(const Fortran::evaluate::StructureConstructor &x) {
// FIXME: hash the contents.
return 149u;
@@ -548,6 +553,10 @@ class IsEqualEvaluateExpr {
return isEqual(x.base(), y.base()) && x.field() == y.field() &&
x.dimension() == y.dimension();
}
+ static bool isEqual(const Fortran::evaluate::RankOneBoundElement &x,
+ const Fortran::evaluate::RankOneBoundElement &y) {
+ return x.dimension() == y.dimension() && isEqual(x.base(), y.base());
+ }
static bool isEqual(const Fortran::evaluate::StructureConstructor &x,
const Fortran::evaluate::StructureConstructor &y) {
const auto &xValues = x.values();
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 42f042e470e81..6bf568bfe8b3a 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -592,8 +592,8 @@ class UnparseVisitor {
common::visitors{
[&](const std::list<ExplicitShapeSpec> &y) { Walk(y, ","); },
[&](const ExplicitShapeBoundsSpec &y) {
- llvm_unreachable(
- "Unparse for ExplicitShapeBoundsSpec should not be reached");
+ Walk(std::get<std::optional<IntExpr>>(y.t), ":");
+ Walk(std::get<IntExpr>(y.t));
},
[&](const std::list<AssumedShapeSpec> &y) { Walk(y, ","); },
[&](const DeferredShapeSpecList &y) { Walk(y); },
diff --git a/flang/lib/Semantics/dump-expr.cpp b/flang/lib/Semantics/dump-expr.cpp
index 8d354cf65b61e..44c7d5a4058cf 100644
--- a/flang/lib/Semantics/dump-expr.cpp
+++ b/flang/lib/Semantics/dump-expr.cpp
@@ -195,6 +195,12 @@ void DumpEvaluateExpr::Show(const evaluate::DescriptorInquiry &x) {
Outdent();
}
+void DumpEvaluateExpr::Show(const evaluate::RankOneBoundElement &x) {
+ Indent(("rank-1 bound element [" + llvm::Twine(x.dimension()) + "]").str());
+ Show(x.base());
+ Outdent();
+}
+
void DumpEvaluateExpr::Print(llvm::Twine twine) {
outs_ << GetIndentString() << twine << '\n';
}
diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 2865d16c68bb8..8cf64152bd783 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -61,6 +61,7 @@ static void PutBound(llvm::raw_ostream &, const Bound &);
static void PutShapeSpec(llvm::raw_ostream &, const ShapeSpec &);
static void PutShape(
llvm::raw_ostream &, const ArraySpec &, char open, char close);
+static bool HasRankOneBound(const ArraySpec &);
static void PutMapper(llvm::raw_ostream &, const Symbol &, SemanticsContext &);
static llvm::raw_ostream &PutAttr(llvm::raw_ostream &, Attr);
@@ -993,18 +994,63 @@ void PutShapeSpec(llvm::raw_ostream &os, const ShapeSpec &x) {
}
}
}
+
+// Check whether any bound in an ArraySpec holds a RankOneBoundElement,
+// indicating the shape came from a rank-1 integer array expression.
+bool HasRankOneBound(const ArraySpec &shape) {
+ const auto &first{shape.front()};
+ if (auto lb{first.lbound().GetExplicit()}) {
+ if (evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*lb)) {
+ return true;
+ }
+ }
+ if (auto ub{first.ubound().GetExplicit()}) {
+ if (evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*ub)) {
+ return true;
+ }
+ }
+ return false;
+}
+
void PutShape(
llvm::raw_ostream &os, const ArraySpec &shape, char open, char close) {
if (!shape.empty()) {
os << open;
- bool first{true};
- for (const auto &shapeSpec : shape) {
- if (first) {
- first = false;
- } else {
- os << ',';
+ if (HasRankOneBound(shape)) {
+ // Rank-1 bounds: all ShapeSpecs share the same rank-1 expression
+ // wrapped in RankOneBoundElement. Extract the base expression from the
+ // first element and emit it whole so the mod file round-trips through
+ // the parser as an ExplicitShapeBoundsSpec.
+ const auto &first{shape.front()};
+ if (!first.lbound().isColon()) {
+ auto lb{first.lbound().GetExplicit()};
+ if (auto *robe =
+ evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*lb)) {
+ robe->base().AsFortran(os);
+ } else {
+ PutBound(os, first.lbound());
+ }
+ }
+ os << ':';
+ if (!first.ubound().isColon()) {
+ auto ub{first.ubound().GetExplicit()};
+ if (auto *robe =
+ evaluate::UnwrapExpr<evaluate::RankOneBoundElement>(*ub)) {
+ robe->base().AsFortran(os);
+ } else {
+ PutBound(os, first.ubound());
+ }
+ }
+ } else {
+ bool first{true};
+ for (const auto &shapeSpec : shape) {
+ if (first) {
+ first = false;
+ } else {
+ os << ',';
+ }
+ PutShapeSpec(os, shapeSpec);
}
- PutShapeSpec(os, shapeSpec);
}
os << close;
}
diff --git a/flang/lib/Semantics/resolve-names-utils.cpp b/flang/lib/Semantics/resolve-names-utils.cpp
index 5adeb46f86a7e..21bd07b9c1c8e 100644
--- a/flang/lib/Semantics/resolve-names-utils.cpp
+++ b/flang/lib/Semantics/resolve-names-utils.cpp
@@ -213,6 +213,13 @@ class ArraySpecAnalyzer {
void MakeDeferred(int);
Bound GetBound(const std::optional<parser::SpecificationExpr> &);
Bound GetBound(const parser::SpecificationExpr &);
+ struct ExplicitShapeBoundsResult {
+ Bound ubound;
+ std::optional<Bound> lbound;
+ std::int64_t numDims;
+ };
+ std::optional<ExplicitShapeBoundsResult> checkExplicitShapeBoundsSpec(
+ const parser::ExplicitShapeBoundsSpec &x);
};
ArraySpec AnalyzeArraySpec(
@@ -343,11 +350,138 @@ void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeSpec &x) {
std::get<parser::SpecificationExpr>(x.t));
}
+std::optional<ArraySpecAnalyzer::ExplicitShapeBoundsResult>
+ArraySpecAnalyzer::checkExplicitShapeBoundsSpec(
+ const parser::ExplicitShapeBoundsSpec &x) {
+ const auto &lowerBoundOpt{std::get<0>(x.t)};
+ const auto &upperBound{std::get<1>(x.t)};
+
+ // Analyze, validate, fold, and wrap one bound expression in a Bound.
+ // Returns the Bound and, for rank-1, the constant extent; for scalar
+ // the extent is 0 (meaning "broadcast").
+ bool hasError{false};
+ auto analyzeBound =
+ [&](const auto &parseBound,
+ bool isUpper) -> std::optional<std::pair<Bound, std::int64_t>> {
+ MaybeExpr expr{AnalyzeExpr(context_, parseBound.thing)};
+ if (expr->Rank() > 1) {
+ context_.Say(parser::FindSourceLocation(parseBound),
+ "Integer array used as %s bounds in DECLARATION must be rank-1 "
+ "but is rank-%d"_err_en_US,
+ isUpper ? "upper" : "lower", expr->Rank());
+ hasError = true;
+ return std::nullopt;
+ }
+ auto folded{evaluate::Fold(context_.foldingContext(), std::move(*expr))};
+ const auto *someInt{evaluate::UnwrapExpr<SomeIntExpr>(folded)};
+ if (!someInt) {
+ hasError = true;
+ return std::nullopt;
+ }
+ auto asSI{evaluate::Fold(context_.foldingContext(),
+ evaluate::ConvertToType<evaluate::SubscriptInteger>(
+ common::Clone(*someInt)))};
+ if (folded.Rank() == 0) {
+ return std::make_pair(
+ Bound{MaybeSubscriptIntExpr{std::move(asSI)}}, std::int64_t{0});
+ }
+ // Rank-1: must have constant extent.
+ auto extents{
+ evaluate::GetConstantExtents(context_.foldingContext(), folded)};
+ if (!extents) {
+ context_.Say(parser::FindSourceLocation(parseBound),
+ "Rank-1 integer array used as %s bounds in DECLARATION must "
+ "have constant size"_err_en_US,
+ isUpper ? "upper" : "lower");
+ hasError = true;
+ return std::nullopt;
+ }
+ return std::make_pair(
+ Bound{MaybeSubscriptIntExpr{std::move(asSI)}}, (*extents)[0]);
+ };
+
+ // Upper bound (required)
+ auto ubResult{analyzeBound(upperBound, /*isUpper=*/true)};
+
+ // Lower bound (optional)
+ std::optional<std::pair<Bound, std::int64_t>> lbResult;
+ if (lowerBoundOpt) {
+ lbResult = analyzeBound(*lowerBoundOpt, /*isUpper=*/false);
+ }
+
+ if (hasError) {
+ return std::nullopt;
+ }
+
+ std::int64_t ubExtent{ubResult->second};
+ std::int64_t lbExtent{lbResult ? lbResult->second : 0};
+
+ // Determine numDims from whichever is rank-1 (extent > 0).
+ std::int64_t numDims{std::max(ubExtent, lbExtent)};
+
+ // Size mismatch check (only when both are rank-1).
+ if (ubExtent > 0 && lbExtent > 0 && ubExtent != lbExtent) {
+ context_.Say(parser::FindSourceLocation(x),
+ "DECLARATION bounds integer rank-1 arrays must have the same size; "
+ "lower bounds has %jd elements, upper bounds has %jd elements"_err_en_US,
+ lbExtent, ubExtent);
+ return std::nullopt;
+ }
+
+ std::optional<Bound> lb;
+ if (lbResult) {
+ lb.emplace(std::move(lbResult->first));
+ }
+ return ExplicitShapeBoundsResult{
+ std::move(ubResult->first), std::move(lb), numDims};
+}
+
void ArraySpecAnalyzer::Analyze(const parser::ExplicitShapeBoundsSpec &x) {
- context_.Say("TODO: Analyze overload for ExplicitShapeBoundsSpec"_todo_en_US);
- // prevent CHECK abort in Analyze(ArraySpec), otherwise it'll abort before
- // printing error message
- arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ auto result{checkExplicitShapeBoundsSpec(x)};
+ // Every path that results in result being false emits an error. In the event
+ // that we bail early without emitting an error, we silently pass the fallback
+ // Bound{1} WITHOUT failing. This check ensures that if we failed, we emitted
+ // an error message. This way we can pass the
+ // CHECK(!arraySpec_.empty());
+ // in Analyze(ArraySpec). If we don't, it'll crash before getting to emit
+ // the real (user) error messages.
+ if (!result) {
+ CHECK(context_.AnyFatalError());
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(Bound{1}));
+ return;
+ }
+ // For rank-1 bounds, emit N ShapeSpecs each wrapping a scalar
+ // RankOneBoundElement that extracts element [dim] from the rank-1
+ // expression. This makes all downstream consumers see scalar bounds.
+ int numDims = static_cast<int>(result->numDims);
+ for (int dim = 0; dim < numDims; ++dim) {
+ // Upper bound
+ MaybeSubscriptIntExpr ubExpr;
+ if (auto &ubOrig = result->ubound.GetExplicit()) {
+ if (ubOrig->Rank() > 0) {
+ ubExpr = SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*ubOrig), dim}};
+ } else {
+ ubExpr = common::Clone(*ubOrig);
+ }
+ }
+ // Lower bound
+ MaybeSubscriptIntExpr lbExpr;
+ if (result->lbound) {
+ if (auto &lbOrig = result->lbound->GetExplicit()) {
+ if (lbOrig->Rank() > 0) {
+ lbExpr = SubscriptIntExpr{
+ evaluate::RankOneBoundElement{common::Clone(*lbOrig), dim}};
+ } else {
+ lbExpr = common::Clone(*lbOrig);
+ }
+ }
+ }
+ Bound lb{lbExpr ? std::move(lbExpr)
+ : MaybeSubscriptIntExpr{SubscriptIntExpr{1}}};
+ Bound ub{std::move(ubExpr)};
+ arraySpec_.push_back(ShapeSpec::MakeExplicit(std::move(lb), std::move(ub)));
+ }
}
void ArraySpecAnalyzer::Analyze(const parser::AssumedImpliedSpec &x) {
diff --git a/flang/test/Semantics/declaration-explicit-array-bounds.f90 b/flang/test/Semantics/declaration-explicit-array-bounds.f90
index 175c6c841677c..11f704e48cfe2 100644
--- a/flang/test/Semantics/declaration-explicit-array-bounds.f90
+++ b/flang/test/Semantics/declaration-explicit-array-bounds.f90
@@ -1,5 +1,24 @@
! RUN: %python %S/test_errors.py %s %flang_fc1 -Wautomatic-in-main-program -Wsaved-local-in-spec-expr
! ---- Module with rank-1 array-bounded declarations, USE'd elsewhere ----
+subroutine array_flatten(int)
+ integer, intent(IN) :: int
+ !Array Constructors produce rank-1 arrays, even with nested arrays,
+ !so neither of these should produce an error or warning.
+ integer :: fff([int, int])
+ integer :: ff([[int, [int, int]]])
+ integer :: arr([(int+i, integer(8) :: i=1_8, 2_8)])
+end subroutine
+module getter
+contains
+ pure function get_bounds() result(r)
+ integer :: r(2)
+ r = [8, 9]
+ end function
+ subroutine foo()
+ ! Function result (rank-1 integer array) as explicit shape bounds
+ integer :: from_func(get_bounds())
+ end subroutine
+end module
module bounds_provider
implicit none
integer, parameter :: dims(3) = [5, 5, 5]
@@ -10,18 +29,14 @@ module consumer
use bounds_provider
implicit none
! Declare arrays using USE-associated rank-1 parameter arrays
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: arr_upper(dims)
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: arr_both(lo : hi)
end module
subroutine sub_consumer()
use bounds_provider, only: dims, lo, hi
implicit none
! USE'd parameter arrays as bounds in a subroutine
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: local_arr(dims)
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: local_arr2(lo : hi)
end subroutine
subroutine sub_use_consumer()
@@ -31,80 +46,93 @@ subroutine sub_use_consumer()
arr_upper = 1
arr_both = 2
end subroutine
+subroutine bar(n, bounds, rank_bounds)
+ integer, intent(IN) :: n
+ integer, intent(IN) :: bounds(:)
+ integer, intent(IN) :: rank_bounds(..)
+ integer :: bounds2(n)
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: arr(bounds)
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: arr2(bounds2)
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: arr3(rank_bounds)
+end subroutine
module data
integer :: rank1_array_module(3) = [5, 5, 5]
- !future_ERROR: Automatic data object 'gg2' may not appear in a module
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: Automatic data object 'gg2' may not appear in a module
integer :: gg2(rank1_array_module)
integer, allocatable :: nonconstsize(:)
- !future_ERROR: Rank-1 integer array used as lower bounds in DECLARATION must have constant size
- !future_ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: Rank-1 integer array used as lower bounds in DECLARATION must have constant size
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
integer :: gg3(nonconstsize : nonconstsize)
end module
program declaration_array_bounds
+ use getter
implicit none
! Valid cases (no errors expected)
! Array upper bound only
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: c([3, 4, 5])
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer, dimension([3, 4, 5]) :: cc
! Array lower and upper bounds, same size
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: d((/2, 3/) : [10, 20])
! Scalar lower, array upper
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: e(2 : [10, 20])
! Array lower, scalar upper
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: f([2, 3] : 10)
! Using non-literal PARAMETER variables
integer, parameter :: rank1_parameter_array(3) = [5,5,5]
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: g(rank1_parameter_array)
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: ggg(rank1_parameter_array * 2 : rank1_parameter_array - 1)
! Negative cases (errors expected)
integer :: rank1_array(3) = [5,5,5]
! Use existing error message for constness checking
- !future_PORTABILITY: specification expression refers to local object 'rank1_array' (initialized and saved) [-Wsaved-local-in-spec-expr]
- !future_PORTABILITY: Automatic data object 'gg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !PORTABILITY: specification expression refers to local object 'rank1_array' (initialized and saved) [-Wsaved-local-in-spec-expr]
+ !PORTABILITY: Automatic data object 'gg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
integer :: gg(rank1_array)
integer :: scalar
- !future_ERROR: Invalid specification expression: reference to local entity 'scalar'
- !future_PORTABILITY: Automatic data object 'gggg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: Invalid specification expression: reference to local entity 'scalar'
+ !PORTABILITY: Automatic data object 'gggg' should not appear in the specification part of a main program [-Wautomatic-in-main-program]
integer :: gggg(rank1_parameter_array : scalar)
!ERROR: Must have INTEGER type, but is REAL(4)
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
integer :: h([1.2,2.2,3.2]:[1,2,3])
- !future_ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 3 elements, upper bounds has 2 elements
integer :: i([1,2,3]:[3,3])
+ !Previously uncaught bug: array of size 1 is being treated as a scalar, and broadcast. This is incorrect.
+ !It should be treated as a size mismatch error like the one above.
+ !ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 1 elements, upper bounds has 2 elements
+ integer :: ii([1] : [1,2])
+ !Test same behavior with vector subscripts
+ !ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 1 elements, upper bounds has 2 elements
+ integer :: abc(rank1_array([scalar]) : rank1_array([scalar, scalar]))
+ !Test same behavior with array slices
+ !ERROR: DECLARATION bounds integer rank-1 arrays must have the same size; lower bounds has 2 elements, upper bounds has 1 elements
+ integer :: abcd(rank1_array(1:3:2) : rank1_array(1:1))
+ ! using a nonconst upper bound or stride for array slices makes the size nonconst. Should error
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: abcde(rank1_parameter_array(1:scalar:1))
+ !ERROR: Rank-1 integer array used as upper bounds in DECLARATION must have constant size
+ integer :: abcdef(rank1_parameter_array(1:1:scalar))
! Test error for rank > 1, fulfilling constness
integer, parameter :: rank2_parameter_array(2,2) = reshape([[1,2],[3,4]], [2,2])
- !future_ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-2
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-2
integer :: j(rank2_parameter_array)
! Test combined bounds error, first bound as before but second bound as wrong rank
! and nonconst
integer :: rank3_array(2,2,2)
- !future_ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-2
- !future_ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-3
- !ERROR: not yet implemented: TODO: Analyze overload for ExplicitShapeBoundsSpec
+ !ERROR: Integer array used as lower bounds in DECLARATION must be rank-1 but is rank-2
+ !ERROR: Integer array used as upper bounds in DECLARATION must be rank-1 but is rank-3
integer :: k(rank2_parameter_array : rank3_array)
! Test that any comma list is parsed as ExplicitShapeSpecList and not rewritten
diff --git a/flang/test/Semantics/modfile-explicit-shape-bounds.f90 b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
new file mode 100644
index 0000000000000..9c8330a8075ba
--- /dev/null
+++ b/flang/test/Semantics/modfile-explicit-shape-bounds.f90
@@ -0,0 +1,52 @@
+! RUN: %python %S/test_modfile.py %s %flang_fc1
+! Test mod-file generation for F2023 explicit-shape bounds using rank-1
+! integer arrays (ExplicitShapeBoundsSpec / RankOneBoundElement).
+
+! PARAMETER rank-1 array as upper bounds
+module m1
+ integer, parameter :: dims(3) = [5, 10, 15]
+ real :: a(dims)
+end module
+
+!Expect: m1.mod
+!module m1
+!integer(4),parameter::dims(1_8:3_8)=[INTEGER(4)::5_4,10_4,15_4]
+!real(4)::a(1_8:[INTEGER(8)::5_8,10_8,15_8])
+!end
+
+! Rank-1 dummy as upper bounds
+module m2
+contains
+subroutine sub1(n,a)
+ integer, intent(in) :: n(3)
+ real :: a(n)
+end subroutine
+end module
+
+!Expect: m2.mod
+!module m2
+!contains
+!subroutine sub1(n,a)
+!integer(4),intent(in)::n(1_8:3_8)
+!real(4)::a(1_8:__builtin_int(n,kind=8))
+!end
+!end
+
+! Both lower and upper rank-1 bounds
+module m3
+contains
+subroutine sub2(lb,ub,a)
+ integer, intent(in) :: lb(2), ub(2)
+ real :: a(lb:ub)
+end subroutine
+end module
+
+!Expect: m3.mod
+!module m3
+!contains
+!subroutine sub2(lb,ub,a)
+!integer(4),intent(in)::lb(1_8:2_8)
+!integer(4),intent(in)::ub(1_8:2_8)
+!real(4)::a(__builtin_int(lb,kind=8):__builtin_int(ub,kind=8))
+!end
+!end
diff --git a/flang/test/Semantics/unparse-explicit-array-bounds.f90 b/flang/test/Semantics/unparse-explicit-array-bounds.f90
new file mode 100644
index 0000000000000..4e1ec7633a740
--- /dev/null
+++ b/flang/test/Semantics/unparse-explicit-array-bounds.f90
@@ -0,0 +1,42 @@
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+
+! Test unparse of ExplicitShapeBoundsSpec (rank-1 integer array bounds).
+
+! Upper bounds only: SHAPE(src)
+subroutine ub_only(src)
+ integer, intent(in) :: src(:,:)
+ integer :: a(SHAPE(src))
+ a = 1
+end subroutine
+!CHECK: INTEGER a([INTEGER(4)::__builtin_int(size(src,dim=1,kind=8),kind=4),__builtin_int(size(src,dim=2,kind=8),kind=4)])
+
+! Lower and upper bounds: lb:ub
+subroutine lb_and_ub(lb, ub)
+ integer, intent(in) :: lb(2), ub(2)
+ integer :: a(lb:ub)
+ a = 1
+end subroutine
+!CHECK: INTEGER a(lb:ub)
+
+! Expression bounds: two*SHAPE(src)
+subroutine expr_bounds(src)
+ integer, intent(in) :: src(:,:,:)
+ integer :: two = 2
+ integer :: a(two*SHAPE(src))
+ integer :: dims(3) = [2,3,4]
+ integer :: b(two * dims)
+ integer :: c(two*SHAPE(src) : two * dims)
+ a = 1
+end subroutine
+!SHAPE can be folded, but dims cannot. Check unparsing for both, then mix them.
+!CHECK: INTEGER a([INTEGER(4)::two*__builtin_int(size(src,dim=1,kind=8),kind=4),two*__builtin_int(size(src,dim=2,kind=8),kind=4),two*__builtin_int(size(src,dim=3,kind=8),kind=4)])
+!CHECK: INTEGER b(two*dims)
+!CHECK: INTEGER c([INTEGER(4)::two*__builtin_int(size(src,dim=1,kind=8),kind=4),two*__builtin_int(size(src,dim=2,kind=8),kind=4),two*__builtin_int(size(src,dim=3,kind=8),kind=4)]:two*dims)
+
+! Parameter bounds
+subroutine param_bounds()
+ integer, parameter :: dims(3) = [2, 3, 4]
+ integer :: a(dims)
+ a = 1
+end subroutine
+!CHECK: INTEGER a([INTEGER(4)::2_4,3_4,4_4])
More information about the flang-commits
mailing list