[flang-commits] [flang] [flang] Revamp evaluate::CoarrayRef (PR #136628)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Mon Apr 21 15:55:29 PDT 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/136628
>From c0de17f4be878555f8731d032a9fefd48d4b7d3f Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 21 Apr 2025 08:20:56 -0700
Subject: [PATCH] [flang] Revamp evaluate::CoarrayRef
Bring the typed expression representation of a coindexed reference
up to F'2023, which removed some restrictions that had allowed the
current representation to suffice for older revisions of the language.
This new representation is somewhat more simple -- it uses a DataRef
as its base, so any subscripts in a part-ref can be represented as
an ArrayRef there.
Update the code that creates the CoarrayRef, and add more checking
to it, as well as actually capturing any STAT=, TEAM=, & TEAM_NUMBER=
specifiers that might appear. Enforce the constraint that the
part-ref must have subscripts if it is an array. (And update a pile
of copied-and-pasted test code that lacked such subscripts.)
---
flang/include/flang/Evaluate/tools.h | 38 ++++-------
flang/include/flang/Evaluate/traverse.h | 3 +-
flang/include/flang/Evaluate/variable.h | 41 ++++--------
flang/lib/Evaluate/check-expression.cpp | 5 +-
flang/lib/Evaluate/fold.cpp | 13 ++--
flang/lib/Evaluate/formatting.cpp | 26 ++------
flang/lib/Evaluate/shape.cpp | 15 +----
flang/lib/Evaluate/tools.cpp | 15 ++++-
flang/lib/Evaluate/variable.cpp | 57 ++++------------
flang/lib/Lower/Support/Utils.cpp | 11 +---
flang/lib/Semantics/check-coarray.cpp | 29 --------
flang/lib/Semantics/check-coarray.h | 3 -
flang/lib/Semantics/dump-expr.cpp | 1 -
flang/lib/Semantics/expression.cpp | 88 +++++++++++++------------
flang/test/Semantics/atomic02.f90 | 2 +-
flang/test/Semantics/atomic03.f90 | 4 +-
flang/test/Semantics/atomic04.f90 | 4 +-
flang/test/Semantics/atomic05.f90 | 2 +-
flang/test/Semantics/atomic06.f90 | 2 +-
flang/test/Semantics/atomic07.f90 | 2 +-
flang/test/Semantics/atomic08.f90 | 2 +-
flang/test/Semantics/atomic09.f90 | 2 +-
flang/test/Semantics/atomic10.f90 | 4 +-
flang/test/Semantics/atomic11.f90 | 2 +-
flang/test/Semantics/coarrays02.f90 | 24 +++++++
flang/test/Semantics/coshape.f90 | 4 +-
flang/test/Semantics/error_stop1b.f90 | 2 +-
flang/test/Semantics/event01b.f90 | 2 +-
flang/test/Semantics/resolve94.f90 | 12 ++--
29 files changed, 162 insertions(+), 253 deletions(-)
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 1414eaf14f7d6..69b541dab9da3 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -391,20 +391,17 @@ template <typename T>
bool IsArrayElement(const Expr<T> &expr, bool intoSubstring = true,
bool skipComponents = false) {
if (auto dataRef{ExtractDataRef(expr, intoSubstring)}) {
- const DataRef *ref{&*dataRef};
- if (skipComponents) {
- while (const Component * component{std::get_if<Component>(&ref->u)}) {
- ref = &component->base();
+ for (const DataRef *ref{&*dataRef}; ref;) {
+ if (const Component * component{std::get_if<Component>(&ref->u)}) {
+ ref = skipComponents ? &component->base() : nullptr;
+ } else if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
+ ref = &coarrayRef->base();
+ } else {
+ return std::holds_alternative<ArrayRef>(ref->u);
}
}
- if (const auto *coarrayRef{std::get_if<CoarrayRef>(&ref->u)}) {
- return !coarrayRef->subscript().empty();
- } else {
- return std::holds_alternative<ArrayRef>(ref->u);
- }
- } else {
- return false;
}
+ return false;
}
template <typename A>
@@ -418,9 +415,6 @@ std::optional<NamedEntity> ExtractNamedEntity(const A &x) {
[](Component &&component) -> std::optional<NamedEntity> {
return NamedEntity{std::move(component)};
},
- [](CoarrayRef &&co) -> std::optional<NamedEntity> {
- return co.GetBase();
- },
[](auto &&) { return std::optional<NamedEntity>{}; },
},
std::move(dataRef->u));
@@ -528,22 +522,14 @@ const Symbol *UnwrapWholeSymbolOrComponentDataRef(const A &x) {
// If an expression is a whole symbol or a whole component designator,
// potentially followed by an image selector, extract and return that symbol,
// else null.
+const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const DataRef &);
template <typename A>
const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const A &x) {
if (auto dataRef{ExtractDataRef(x)}) {
- if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef->u)}) {
- return &p->get();
- } else if (const Component * c{std::get_if<Component>(&dataRef->u)}) {
- if (c->base().Rank() == 0) {
- return &c->GetLastSymbol();
- }
- } else if (const CoarrayRef * c{std::get_if<CoarrayRef>(&dataRef->u)}) {
- if (c->subscript().empty()) {
- return &c->GetLastSymbol();
- }
- }
+ return UnwrapWholeSymbolOrComponentOrCoarrayRef(*dataRef);
+ } else {
+ return nullptr;
}
- return nullptr;
}
// GetFirstSymbol(A%B%C[I]%D) -> A
diff --git a/flang/include/flang/Evaluate/traverse.h b/flang/include/flang/Evaluate/traverse.h
index 45402143604f4..48aafa8982559 100644
--- a/flang/include/flang/Evaluate/traverse.h
+++ b/flang/include/flang/Evaluate/traverse.h
@@ -146,8 +146,7 @@ class Traverse {
return Combine(x.base(), x.subscript());
}
Result operator()(const CoarrayRef &x) const {
- return Combine(
- x.base(), x.subscript(), x.cosubscript(), x.stat(), x.team());
+ return Combine(x.base(), x.cosubscript(), x.stat(), x.team());
}
Result operator()(const DataRef &x) const { return visitor_(x.u); }
Result operator()(const Substring &x) const {
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index 7f1518fd26e78..5c14421fd3a1b 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -98,8 +98,6 @@ class Component {
// A NamedEntity is either a whole Symbol or a component in an instance
// of a derived type. It may be a descriptor.
-// TODO: this is basically a symbol with an optional DataRef base;
-// could be used to replace Component.
class NamedEntity {
public:
CLASS_BOILERPLATE(NamedEntity)
@@ -239,28 +237,16 @@ class ArrayRef {
std::vector<Subscript> subscript_;
};
-// R914 coindexed-named-object
-// R924 image-selector, R926 image-selector-spec.
-// C825 severely limits the usage of derived types with coarray ultimate
-// components: they can't be pointers, allocatables, arrays, coarrays, or
-// function results. They can be components of other derived types.
-// Although the F'2018 Standard never prohibits multiple image-selectors
-// per se in the same data-ref or designator, nor the presence of an
-// image-selector after a part-ref with rank, the constraints on the
-// derived types that would have be involved make it impossible to declare
-// an object that could be referenced in these ways (esp. C748 & C825).
-// C930 precludes having both TEAM= and TEAM_NUMBER=.
-// TODO C931 prohibits the use of a coindexed object as a stat-variable.
+// A coindexed data-ref. The base is represented as a general
+// DataRef, but the base may not contain a CoarrayRef and may
+// have rank > 0 only in an uppermost ArrayRef.
class CoarrayRef {
public:
CLASS_BOILERPLATE(CoarrayRef)
- CoarrayRef(SymbolVector &&, std::vector<Subscript> &&,
- std::vector<Expr<SubscriptInteger>> &&);
+ CoarrayRef(DataRef &&, std::vector<Expr<SubscriptInteger>> &&);
- const SymbolVector &base() const { return base_; }
- SymbolVector &base() { return base_; }
- const std::vector<Subscript> &subscript() const { return subscript_; }
- std::vector<Subscript> &subscript() { return subscript_; }
+ const DataRef &base() const { return base_.value(); }
+ DataRef &base() { return base_.value(); }
const std::vector<Expr<SubscriptInteger>> &cosubscript() const {
return cosubscript_;
}
@@ -270,25 +256,24 @@ class CoarrayRef {
// (i.e., Designator or pointer-valued FunctionRef).
std::optional<Expr<SomeInteger>> stat() const;
CoarrayRef &set_stat(Expr<SomeInteger> &&);
- std::optional<Expr<SomeInteger>> team() const;
- bool teamIsTeamNumber() const { return teamIsTeamNumber_; }
- CoarrayRef &set_team(Expr<SomeInteger> &&, bool isTeamNumber = false);
+ // When team() is Expr<SomeInteger>, it's TEAM_NUMBER=; otherwise,
+ // it's TEAM=.
+ std::optional<Expr<SomeType>> team() const;
+ CoarrayRef &set_team(Expr<SomeType> &&);
int Rank() const;
int Corank() const { return 0; }
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
- NamedEntity GetBase() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const CoarrayRef &) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
private:
- SymbolVector base_;
- std::vector<Subscript> subscript_;
+ common::CopyableIndirection<DataRef> base_;
std::vector<Expr<SubscriptInteger>> cosubscript_;
- std::optional<common::CopyableIndirection<Expr<SomeInteger>>> stat_, team_;
- bool teamIsTeamNumber_{false}; // false: TEAM=, true: TEAM_NUMBER=
+ std::optional<common::CopyableIndirection<Expr<SomeInteger>>> stat_;
+ std::optional<common::CopyableIndirection<Expr<SomeType>>> team_;
};
// R911 data-ref is defined syntactically as a series of part-refs, which
diff --git a/flang/lib/Evaluate/check-expression.cpp b/flang/lib/Evaluate/check-expression.cpp
index d8baaf2e2a7ac..3d7f01d56c465 100644
--- a/flang/lib/Evaluate/check-expression.cpp
+++ b/flang/lib/Evaluate/check-expression.cpp
@@ -946,10 +946,7 @@ class IsContiguousHelper
return std::nullopt;
}
}
- Result operator()(const CoarrayRef &x) const {
- int rank{0};
- return CheckSubscripts(x.subscript(), rank).has_value();
- }
+ Result operator()(const CoarrayRef &x) const { return (*this)(x.base()); }
Result operator()(const Component &x) const {
if (x.base().Rank() == 0) {
return (*this)(x.GetLastSymbol());
diff --git a/flang/lib/Evaluate/fold.cpp b/flang/lib/Evaluate/fold.cpp
index 5fc31728ce5d6..45e842abf589f 100644
--- a/flang/lib/Evaluate/fold.cpp
+++ b/flang/lib/Evaluate/fold.cpp
@@ -162,22 +162,17 @@ ArrayRef FoldOperation(FoldingContext &context, ArrayRef &&arrayRef) {
}
CoarrayRef FoldOperation(FoldingContext &context, CoarrayRef &&coarrayRef) {
- std::vector<Subscript> subscript;
- for (Subscript x : coarrayRef.subscript()) {
- subscript.emplace_back(FoldOperation(context, std::move(x)));
- }
+ DataRef base{FoldOperation(context, std::move(coarrayRef.base()))};
std::vector<Expr<SubscriptInteger>> cosubscript;
for (Expr<SubscriptInteger> x : coarrayRef.cosubscript()) {
cosubscript.emplace_back(Fold(context, std::move(x)));
}
- CoarrayRef folded{std::move(coarrayRef.base()), std::move(subscript),
- std::move(cosubscript)};
+ CoarrayRef folded{std::move(base), std::move(cosubscript)};
if (std::optional<Expr<SomeInteger>> stat{coarrayRef.stat()}) {
folded.set_stat(Fold(context, std::move(*stat)));
}
- if (std::optional<Expr<SomeInteger>> team{coarrayRef.team()}) {
- folded.set_team(
- Fold(context, std::move(*team)), coarrayRef.teamIsTeamNumber());
+ if (std::optional<Expr<SomeType>> team{coarrayRef.team()}) {
+ folded.set_team(Fold(context, std::move(*team)));
}
return folded;
}
diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp
index 6778fac9a44fd..121afc6f0f8bf 100644
--- a/flang/lib/Evaluate/formatting.cpp
+++ b/flang/lib/Evaluate/formatting.cpp
@@ -723,24 +723,8 @@ llvm::raw_ostream &ArrayRef::AsFortran(llvm::raw_ostream &o) const {
}
llvm::raw_ostream &CoarrayRef::AsFortran(llvm::raw_ostream &o) const {
- bool first{true};
- for (const Symbol &part : base_) {
- if (first) {
- first = false;
- } else {
- o << '%';
- }
- EmitVar(o, part);
- }
- char separator{'('};
- for (const auto &sscript : subscript_) {
- EmitVar(o << separator, sscript);
- separator = ',';
- }
- if (separator == ',') {
- o << ')';
- }
- separator = '[';
+ base().AsFortran(o);
+ char separator{'['};
for (const auto &css : cosubscript_) {
EmitVar(o << separator, css);
separator = ',';
@@ -750,8 +734,10 @@ llvm::raw_ostream &CoarrayRef::AsFortran(llvm::raw_ostream &o) const {
separator = ',';
}
if (team_) {
- EmitVar(
- o << separator, team_, teamIsTeamNumber_ ? "TEAM_NUMBER=" : "TEAM=");
+ EmitVar(o << separator, team_,
+ std::holds_alternative<Expr<SomeInteger>>(team_->value().u)
+ ? "TEAM_NUMBER="
+ : "TEAM=");
}
return o << ']';
}
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index f620ecd4a24bb..ac4811e9978eb 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -891,20 +891,7 @@ auto GetShapeHelper::operator()(const ArrayRef &arrayRef) const -> Result {
}
auto GetShapeHelper::operator()(const CoarrayRef &coarrayRef) const -> Result {
- NamedEntity base{coarrayRef.GetBase()};
- if (coarrayRef.subscript().empty()) {
- return (*this)(base);
- } else {
- Shape shape;
- int dimension{0};
- for (const Subscript &ss : coarrayRef.subscript()) {
- if (ss.Rank() > 0) {
- shape.emplace_back(GetExtent(ss, base, dimension));
- }
- ++dimension;
- }
- return shape;
- }
+ return (*this)(coarrayRef.base());
}
auto GetShapeHelper::operator()(const Substring &substring) const -> Result {
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 702711e3cff53..d39e4c42928f3 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -1090,7 +1090,7 @@ auto GetSymbolVectorHelper::operator()(const ArrayRef &x) const -> Result {
return GetSymbolVector(x.base());
}
auto GetSymbolVectorHelper::operator()(const CoarrayRef &x) const -> Result {
- return x.base();
+ return GetSymbolVector(x.base());
}
const Symbol *GetLastTarget(const SymbolVector &symbols) {
@@ -1320,6 +1320,19 @@ std::optional<parser::MessageFixedText> CheckProcCompatibility(bool isCall,
return msg;
}
+const Symbol *UnwrapWholeSymbolOrComponentOrCoarrayRef(const DataRef &dataRef) {
+ if (const SymbolRef * p{std::get_if<SymbolRef>(&dataRef.u)}) {
+ return &p->get();
+ } else if (const Component * c{std::get_if<Component>(&dataRef.u)}) {
+ if (c->base().Rank() == 0) {
+ return &c->GetLastSymbol();
+ }
+ } else if (const CoarrayRef * c{std::get_if<CoarrayRef>(&dataRef.u)}) {
+ return UnwrapWholeSymbolOrComponentOrCoarrayRef(c->base());
+ }
+ return nullptr;
+}
+
// GetLastPointerSymbol()
static const Symbol *GetLastPointerSymbol(const Symbol &symbol) {
return IsPointer(GetAssociationRoot(symbol)) ? &symbol : nullptr;
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 849194b492053..d1bff03a6ea5f 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -69,13 +69,9 @@ Triplet &Triplet::set_stride(Expr<SubscriptInteger> &&expr) {
return *this;
}
-CoarrayRef::CoarrayRef(SymbolVector &&base, std::vector<Subscript> &&ss,
- std::vector<Expr<SubscriptInteger>> &&css)
- : base_{std::move(base)}, subscript_(std::move(ss)),
- cosubscript_(std::move(css)) {
- CHECK(!base_.empty());
- CHECK(!cosubscript_.empty());
-}
+CoarrayRef::CoarrayRef(
+ DataRef &&base, std::vector<Expr<SubscriptInteger>> &&css)
+ : base_{std::move(base)}, cosubscript_(std::move(css)) {}
std::optional<Expr<SomeInteger>> CoarrayRef::stat() const {
if (stat_) {
@@ -85,7 +81,7 @@ std::optional<Expr<SomeInteger>> CoarrayRef::stat() const {
}
}
-std::optional<Expr<SomeInteger>> CoarrayRef::team() const {
+std::optional<Expr<SomeType>> CoarrayRef::team() const {
if (team_) {
return team_.value().value();
} else {
@@ -99,16 +95,18 @@ CoarrayRef &CoarrayRef::set_stat(Expr<SomeInteger> &&v) {
return *this;
}
-CoarrayRef &CoarrayRef::set_team(Expr<SomeInteger> &&v, bool isTeamNumber) {
- CHECK(IsVariable(v));
+CoarrayRef &CoarrayRef::set_team(Expr<SomeType> &&v) {
team_.emplace(std::move(v));
- teamIsTeamNumber_ = isTeamNumber;
return *this;
}
-const Symbol &CoarrayRef::GetFirstSymbol() const { return base_.front(); }
+const Symbol &CoarrayRef::GetFirstSymbol() const {
+ return base().GetFirstSymbol();
+}
-const Symbol &CoarrayRef::GetLastSymbol() const { return base_.back(); }
+const Symbol &CoarrayRef::GetLastSymbol() const {
+ return base().GetLastSymbol();
+}
void Substring::SetBounds(std::optional<Expr<SubscriptInteger>> &lower,
std::optional<Expr<SubscriptInteger>> &upper) {
@@ -426,17 +424,7 @@ int ArrayRef::Rank() const {
}
}
-int CoarrayRef::Rank() const {
- if (!subscript_.empty()) {
- int rank{0};
- for (const auto &expr : subscript_) {
- rank += expr.Rank();
- }
- return rank;
- } else {
- return base_.back()->Rank();
- }
-}
+int CoarrayRef::Rank() const { return base().Rank(); }
int DataRef::Rank() const {
return common::visit(common::visitors{
@@ -671,22 +659,6 @@ std::optional<DynamicType> Designator<T>::GetType() const {
return std::nullopt;
}
-static NamedEntity AsNamedEntity(const SymbolVector &x) {
- CHECK(!x.empty());
- NamedEntity result{x.front()};
- int j{0};
- for (const Symbol &symbol : x) {
- if (j++ != 0) {
- DataRef base{result.IsSymbol() ? DataRef{result.GetLastSymbol()}
- : DataRef{result.GetComponent()}};
- result = NamedEntity{Component{std::move(base), symbol}};
- }
- }
- return result;
-}
-
-NamedEntity CoarrayRef::GetBase() const { return AsNamedEntity(base_); }
-
// Equality testing
// For the purposes of comparing type parameter expressions while
@@ -759,9 +731,8 @@ bool ArrayRef::operator==(const ArrayRef &that) const {
return base_ == that.base_ && subscript_ == that.subscript_;
}
bool CoarrayRef::operator==(const CoarrayRef &that) const {
- return base_ == that.base_ && subscript_ == that.subscript_ &&
- cosubscript_ == that.cosubscript_ && stat_ == that.stat_ &&
- team_ == that.team_ && teamIsTeamNumber_ == that.teamIsTeamNumber_;
+ return base_ == that.base_ && cosubscript_ == that.cosubscript_ &&
+ stat_ == that.stat_ && team_ == that.team_;
}
bool DataRef::operator==(const DataRef &that) const {
return TestVariableEquality(*this, that);
diff --git a/flang/lib/Lower/Support/Utils.cpp b/flang/lib/Lower/Support/Utils.cpp
index ed2700c42fc55..668ee31a36bc3 100644
--- a/flang/lib/Lower/Support/Utils.cpp
+++ b/flang/lib/Lower/Support/Utils.cpp
@@ -70,18 +70,12 @@ class HashEvaluateExpr {
return getHashValue(x.base()) * 89u - subs;
}
static unsigned getHashValue(const Fortran::evaluate::CoarrayRef &x) {
- unsigned subs = 1u;
- for (const Fortran::evaluate::Subscript &v : x.subscript())
- subs -= getHashValue(v);
unsigned cosubs = 3u;
for (const Fortran::evaluate::Expr<Fortran::evaluate::SubscriptInteger> &v :
x.cosubscript())
cosubs -= getHashValue(v);
- unsigned syms = 7u;
- for (const Fortran::evaluate::SymbolRef &v : x.base())
- syms += getHashValue(v);
- return syms * 97u - subs - cosubs + getHashValue(x.stat()) + 257u +
- getHashValue(x.team());
+ return getHashValue(x.base()) * 97u - cosubs + getHashValue(x.stat()) +
+ 257u + getHashValue(x.team());
}
static unsigned getHashValue(const Fortran::evaluate::NamedEntity &x) {
if (x.IsSymbol())
@@ -339,7 +333,6 @@ class IsEqualEvaluateExpr {
static bool isEqual(const Fortran::evaluate::CoarrayRef &x,
const Fortran::evaluate::CoarrayRef &y) {
return isEqual(x.base(), y.base()) &&
- isEqual(x.subscript(), y.subscript()) &&
isEqual(x.cosubscript(), y.cosubscript()) &&
isEqual(x.stat(), y.stat()) && isEqual(x.team(), y.team());
}
diff --git a/flang/lib/Semantics/check-coarray.cpp b/flang/lib/Semantics/check-coarray.cpp
index b21e3cd757d6b..0e444f155f116 100644
--- a/flang/lib/Semantics/check-coarray.cpp
+++ b/flang/lib/Semantics/check-coarray.cpp
@@ -373,41 +373,12 @@ void CoarrayChecker::Leave(const parser::CriticalStmt &x) {
}
void CoarrayChecker::Leave(const parser::ImageSelector &imageSelector) {
- haveStat_ = false;
- haveTeam_ = false;
- haveTeamNumber_ = false;
for (const auto &imageSelectorSpec :
std::get<std::list<parser::ImageSelectorSpec>>(imageSelector.t)) {
- if (const auto *team{
- std::get_if<parser::TeamValue>(&imageSelectorSpec.u)}) {
- if (haveTeam_) {
- context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
- "TEAM value can only be specified once"_err_en_US);
- }
- CheckTeamType(context_, *team);
- haveTeam_ = true;
- }
if (const auto *stat{std::get_if<parser::ImageSelectorSpec::Stat>(
&imageSelectorSpec.u)}) {
- if (haveStat_) {
- context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
- "STAT variable can only be specified once"_err_en_US);
- }
CheckTeamStat(context_, *stat);
- haveStat_ = true;
}
- if (std::get_if<parser::ImageSelectorSpec::Team_Number>(
- &imageSelectorSpec.u)) {
- if (haveTeamNumber_) {
- context_.Say(parser::FindSourceLocation(imageSelectorSpec), // C929
- "TEAM_NUMBER value can only be specified once"_err_en_US);
- }
- haveTeamNumber_ = true;
- }
- }
- if (haveTeam_ && haveTeamNumber_) {
- context_.Say(parser::FindSourceLocation(imageSelector), // C930
- "Cannot specify both TEAM and TEAM_NUMBER"_err_en_US);
}
}
diff --git a/flang/lib/Semantics/check-coarray.h b/flang/lib/Semantics/check-coarray.h
index f156959019383..51de47f123558 100644
--- a/flang/lib/Semantics/check-coarray.h
+++ b/flang/lib/Semantics/check-coarray.h
@@ -37,9 +37,6 @@ class CoarrayChecker : public virtual BaseChecker {
private:
SemanticsContext &context_;
- bool haveStat_;
- bool haveTeam_;
- bool haveTeamNumber_;
void CheckNamesAreDistinct(const std::list<parser::CoarrayAssociation> &);
void Say2(const parser::CharBlock &, parser::MessageFixedText &&,
diff --git a/flang/lib/Semantics/dump-expr.cpp b/flang/lib/Semantics/dump-expr.cpp
index 850904bf897b9..aa0b4e0f03398 100644
--- a/flang/lib/Semantics/dump-expr.cpp
+++ b/flang/lib/Semantics/dump-expr.cpp
@@ -22,7 +22,6 @@ inline const char *DumpEvaluateExpr::GetIndentString() const {
void DumpEvaluateExpr::Show(const evaluate::CoarrayRef &x) {
Indent("coarray ref");
Show(x.base());
- Show(x.subscript());
Show(x.cosubscript());
Show(x.stat());
Show(x.team());
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index e139bda7e4950..0659536aab98c 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -419,13 +419,9 @@ static void CheckSubscripts(
}
}
-static void CheckSubscripts(
+static void CheckCosubscripts(
semantics::SemanticsContext &context, CoarrayRef &ref) {
- const Symbol &coarraySymbol{ref.GetBase().GetLastSymbol()};
- Shape lb, ub;
- if (FoldSubscripts(context, coarraySymbol, ref.subscript(), lb, ub)) {
- ValidateSubscripts(context, coarraySymbol, ref.subscript(), lb, ub);
- }
+ const Symbol &coarraySymbol{ref.GetLastSymbol()};
FoldingContext &foldingContext{context.foldingContext()};
int dim{0};
for (auto &expr : ref.cosubscript()) {
@@ -1534,29 +1530,10 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::StructureComponent &sc) {
}
MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
- if (auto maybeDataRef{ExtractDataRef(Analyze(x.base))}) {
- DataRef *dataRef{&*maybeDataRef};
- std::vector<Subscript> subscripts;
- SymbolVector reversed;
- if (auto *aRef{std::get_if<ArrayRef>(&dataRef->u)}) {
- subscripts = std::move(aRef->subscript());
- reversed.push_back(aRef->GetLastSymbol());
- if (Component *component{aRef->base().UnwrapComponent()}) {
- dataRef = &component->base();
- } else {
- dataRef = nullptr;
- }
- }
- if (dataRef) {
- while (auto *component{std::get_if<Component>(&dataRef->u)}) {
- reversed.push_back(component->GetLastSymbol());
- dataRef = &component->base();
- }
- if (auto *baseSym{std::get_if<SymbolRef>(&dataRef->u)}) {
- reversed.push_back(*baseSym);
- } else {
- Say("Base of coindexed named object has subscripts or cosubscripts"_err_en_US);
- }
+ if (auto dataRef{ExtractDataRef(Analyze(x.base))}) {
+ if (!std::holds_alternative<ArrayRef>(dataRef->u) &&
+ dataRef->GetLastSymbol().Rank() > 0) { // F'2023 C916
+ Say("Subscripts must appear in a coindexed reference when its base is an array"_err_en_US);
}
std::vector<Expr<SubscriptInteger>> cosubscripts;
bool cosubsOk{true};
@@ -1570,30 +1547,59 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
cosubsOk = false;
}
}
- if (cosubsOk && !reversed.empty()) {
+ if (cosubsOk) {
int numCosubscripts{static_cast<int>(cosubscripts.size())};
- const Symbol &symbol{reversed.front()};
+ const Symbol &symbol{dataRef->GetLastSymbol()};
if (numCosubscripts != GetCorank(symbol)) {
Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
symbol.name(), GetCorank(symbol), numCosubscripts);
}
}
+ CoarrayRef coarrayRef{std::move(*dataRef), std::move(cosubscripts)};
for (const auto &imageSelSpec :
std::get<std::list<parser::ImageSelectorSpec>>(x.imageSelector.t)) {
common::visit(
common::visitors{
- [&](const auto &x) { Analyze(x.v); },
- },
+ [&](const parser::ImageSelectorSpec::Stat &x) {
+ Analyze(x.v);
+ if (const auto *expr{GetExpr(context_, x.v)}) {
+ if (const auto *intExpr{
+ std::get_if<Expr<SomeInteger>>(&expr->u)}) {
+ if (coarrayRef.stat()) {
+ Say("coindexed reference has multiple STAT= specifiers"_err_en_US);
+ } else {
+ coarrayRef.set_stat(Expr<SomeInteger>{*intExpr});
+ }
+ }
+ }
+ },
+ [&](const parser::TeamValue &x) {
+ Analyze(x.v);
+ if (const auto *expr{GetExpr(context_, x.v)}) {
+ if (coarrayRef.team()) {
+ Say("coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers"_err_en_US);
+ } else if (auto dyType{expr->GetType()};
+ dyType && IsTeamType(GetDerivedTypeSpec(*dyType))) {
+ coarrayRef.set_team(Expr<SomeType>{*expr});
+ } else {
+ Say("TEAM= specifier must have type TEAM_TYPE from ISO_FORTRAN_ENV"_err_en_US);
+ }
+ }
+ },
+ [&](const parser::ImageSelectorSpec::Team_Number &x) {
+ Analyze(x.v);
+ if (const auto *expr{GetExpr(context_, x.v)}) {
+ if (coarrayRef.team()) {
+ Say("coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers"_err_en_US);
+ } else {
+ coarrayRef.set_team(Expr<SomeType>{*expr});
+ }
+ }
+ }},
imageSelSpec.u);
}
- // Reverse the chain of symbols so that the base is first and coarray
- // ultimate component is last.
- if (cosubsOk) {
- CoarrayRef coarrayRef{SymbolVector{reversed.crbegin(), reversed.crend()},
- std::move(subscripts), std::move(cosubscripts)};
- CheckSubscripts(context_, coarrayRef);
- return Designate(DataRef{std::move(coarrayRef)});
- }
+ CheckCosubscripts(context_, coarrayRef);
+ return Designate(DataRef{std::move(coarrayRef)});
}
return std::nullopt;
}
diff --git a/flang/test/Semantics/atomic02.f90 b/flang/test/Semantics/atomic02.f90
index 484239a23ede2..0d107152a8c14 100644
--- a/flang/test/Semantics/atomic02.f90
+++ b/flang/test/Semantics/atomic02.f90
@@ -31,7 +31,7 @@ program test_atomic_and
call atomic_and(non_scalar_coarray, val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_and'
- call atomic_and(non_scalar_coarray[1], val)
+ call atomic_and(non_scalar_coarray(:)[1], val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_and'
call atomic_and(non_coarray, val)
diff --git a/flang/test/Semantics/atomic03.f90 b/flang/test/Semantics/atomic03.f90
index 495df5eb97192..cef21d002dd68 100644
--- a/flang/test/Semantics/atomic03.f90
+++ b/flang/test/Semantics/atomic03.f90
@@ -51,13 +51,13 @@ program test_atomic_cas
call atomic_cas(non_scalar_coarray, old_int, compare_int, new_int)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_cas'
- call atomic_cas(non_scalar_coarray[1], old_int, compare_int, new_int)
+ call atomic_cas(non_scalar_coarray(:)[1], old_int, compare_int, new_int)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_cas'
call atomic_cas(non_scalar_logical_coarray, old_logical, compare_logical, new_logical)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_cas'
- call atomic_cas(non_scalar_logical_coarray[1], old_logical, compare_logical, new_logical)
+ call atomic_cas(non_scalar_logical_coarray(:)[1], old_logical, compare_logical, new_logical)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_cas'
call atomic_cas(non_coarray, old_int, compare_int, new_int)
diff --git a/flang/test/Semantics/atomic04.f90 b/flang/test/Semantics/atomic04.f90
index 9df0b56d192a8..453fdb10e7f49 100644
--- a/flang/test/Semantics/atomic04.f90
+++ b/flang/test/Semantics/atomic04.f90
@@ -47,13 +47,13 @@ program test_atomic_define
call atomic_define(non_scalar_coarray, val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
- call atomic_define(non_scalar_coarray[1], val)
+ call atomic_define(non_scalar_coarray(:)[1], val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
call atomic_define(non_scalar_logical_coarray, val_logical)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
- call atomic_define(non_scalar_logical_coarray[1], val_logical)
+ call atomic_define(non_scalar_logical_coarray(:)[1], val_logical)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_define'
call atomic_define(non_coarray, val)
diff --git a/flang/test/Semantics/atomic05.f90 b/flang/test/Semantics/atomic05.f90
index 98d6b19b1f23d..c1e67b0d454fe 100644
--- a/flang/test/Semantics/atomic05.f90
+++ b/flang/test/Semantics/atomic05.f90
@@ -41,7 +41,7 @@ program test_atomic_fetch_add
call atomic_fetch_add(array, val, old_val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_add'
- call atomic_fetch_add(non_scalar_coarray[1], val, old_val)
+ call atomic_fetch_add(non_scalar_coarray(:)[1], val, old_val)
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_fetch_add(default_kind_coarray, val, old_val)
diff --git a/flang/test/Semantics/atomic06.f90 b/flang/test/Semantics/atomic06.f90
index c6a23dd0077ca..57cc81e9c4a97 100644
--- a/flang/test/Semantics/atomic06.f90
+++ b/flang/test/Semantics/atomic06.f90
@@ -41,7 +41,7 @@ program test_atomic_fetch_and
call atomic_fetch_and(array, val, old_val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_and'
- call atomic_fetch_and(non_scalar_coarray[1], val, old_val)
+ call atomic_fetch_and(non_scalar_coarray(:)[1], val, old_val)
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_fetch_and(default_kind_coarray, val, old_val)
diff --git a/flang/test/Semantics/atomic07.f90 b/flang/test/Semantics/atomic07.f90
index 2bc544b757864..e4d80956ed036 100644
--- a/flang/test/Semantics/atomic07.f90
+++ b/flang/test/Semantics/atomic07.f90
@@ -34,7 +34,7 @@ program test_atomic_fetch_or
call atomic_fetch_or(array, val, old_val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_or'
- call atomic_fetch_or(non_scalar_coarray[1], val, old_val)
+ call atomic_fetch_or(non_scalar_coarray(:)[1], val, old_val)
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_fetch_or(default_kind_coarray, val, old_val)
diff --git a/flang/test/Semantics/atomic08.f90 b/flang/test/Semantics/atomic08.f90
index f519f9735e00e..234e6e3923620 100644
--- a/flang/test/Semantics/atomic08.f90
+++ b/flang/test/Semantics/atomic08.f90
@@ -41,7 +41,7 @@ program test_atomic_fetch_xor
call atomic_fetch_xor(array, val, old_val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_fetch_xor'
- call atomic_fetch_xor(non_scalar_coarray[1], val, old_val)
+ call atomic_fetch_xor(non_scalar_coarray(:)[1], val, old_val)
!ERROR: Actual argument for 'atom=' must have kind=atomic_int_kind, but is 'INTEGER(4)'
call atomic_fetch_xor(default_kind_coarray, val, old_val)
diff --git a/flang/test/Semantics/atomic09.f90 b/flang/test/Semantics/atomic09.f90
index e4e062252659a..4f78ccb977186 100644
--- a/flang/test/Semantics/atomic09.f90
+++ b/flang/test/Semantics/atomic09.f90
@@ -31,7 +31,7 @@ program test_atomic_or
call atomic_or(non_scalar_coarray, val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or'
- call atomic_or(non_scalar_coarray[1], val)
+ call atomic_or(non_scalar_coarray(:)[1], val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_or'
call atomic_or(non_coarray, val)
diff --git a/flang/test/Semantics/atomic10.f90 b/flang/test/Semantics/atomic10.f90
index 04efbd6e80fd2..e206326786042 100644
--- a/flang/test/Semantics/atomic10.f90
+++ b/flang/test/Semantics/atomic10.f90
@@ -47,13 +47,13 @@ program test_atomic_ref
call atomic_ref(val, non_scalar_coarray)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_ref'
- call atomic_ref(val, non_scalar_coarray[1])
+ call atomic_ref(val, non_scalar_coarray(:)[1])
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_ref'
call atomic_ref(val_logical, non_scalar_logical_coarray)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_ref'
- call atomic_ref(val_logical, non_scalar_logical_coarray[1])
+ call atomic_ref(val_logical, non_scalar_logical_coarray(:)[1])
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_ref'
call atomic_ref(val, non_coarray)
diff --git a/flang/test/Semantics/atomic11.f90 b/flang/test/Semantics/atomic11.f90
index d4f951ea02c32..dba7dfdf5ae47 100644
--- a/flang/test/Semantics/atomic11.f90
+++ b/flang/test/Semantics/atomic11.f90
@@ -31,7 +31,7 @@ program test_atomic_xor
call atomic_xor(non_scalar_coarray, val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
- call atomic_xor(non_scalar_coarray[1], val)
+ call atomic_xor(non_scalar_coarray(:)[1], val)
!ERROR: 'atom=' argument must be a scalar coarray or coindexed object for intrinsic 'atomic_xor'
call atomic_xor(non_coarray, val)
diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90
index dc907161250ab..b16e0ccb58797 100644
--- a/flang/test/Semantics/coarrays02.f90
+++ b/flang/test/Semantics/coarrays02.f90
@@ -96,3 +96,27 @@ subroutine test(cat)
call sub(cat%p)
end
end
+
+subroutine s4
+ type t
+ real, allocatable :: a(:)[:]
+ end type
+ type t2
+ !ERROR: Allocatable or array component 'bad1' may not have a coarray ultimate component '%a'
+ type(t), allocatable :: bad1
+ !ERROR: Pointer 'bad2' may not have a coarray potential component '%a'
+ type(t), pointer :: bad2
+ !ERROR: Allocatable or array component 'bad3' may not have a coarray ultimate component '%a'
+ type(t) :: bad3(2)
+ !ERROR: Component 'bad4' is a coarray and must have the ALLOCATABLE attribute and have a deferred coshape
+ !ERROR: Coarray 'bad4' may not have a coarray potential component '%a'
+ type(t) :: bad4[*]
+ end type
+ type(t), save :: ta(2)
+ !ERROR: 'a' has corank 1, but coindexed reference has 2 cosubscripts
+ print *, ta(1)%a(1)[1,2]
+ !ERROR: An allocatable or pointer component reference must be applied to a scalar base
+ print *, ta(:)%a(1)[1]
+ !ERROR: Subscripts must appear in a coindexed reference when its base is an array
+ print *, ta(1)%a[1]
+end
diff --git a/flang/test/Semantics/coshape.f90 b/flang/test/Semantics/coshape.f90
index d4fb45df6600c..d4e3f2d25280d 100644
--- a/flang/test/Semantics/coshape.f90
+++ b/flang/test/Semantics/coshape.f90
@@ -40,9 +40,9 @@ program coshape_tests
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'coshape'
codimensions = coshape(derived_scalar_coarray[1]%x)
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'coshape'
- codimensions = coshape(derived_array_coarray[1]%x)
+ codimensions = coshape(derived_array_coarray(:)[1]%x)
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'coshape'
- codimensions = coshape(array_coarray[1])
+ codimensions = coshape(array_coarray(:)[1])
!ERROR: 'coarray=' argument must have corank > 0 for intrinsic 'coshape'
codimensions = coshape(scalar_coarray[1])
diff --git a/flang/test/Semantics/error_stop1b.f90 b/flang/test/Semantics/error_stop1b.f90
index 355a049560102..3c9ace13693ac 100644
--- a/flang/test/Semantics/error_stop1b.f90
+++ b/flang/test/Semantics/error_stop1b.f90
@@ -32,7 +32,7 @@ program test_error_stop
error stop char_array
!ERROR: Must be a scalar value, but is a rank-1 array
- error stop array_coarray[1]
+ error stop array_coarray(:)[1]
!ERROR: Must have LOGICAL type, but is CHARACTER(KIND=1,LEN=128_8)
error stop int_code, quiet=non_logical
diff --git a/flang/test/Semantics/event01b.f90 b/flang/test/Semantics/event01b.f90
index 0cd8a5bcb1f1f..b11118783eaee 100644
--- a/flang/test/Semantics/event01b.f90
+++ b/flang/test/Semantics/event01b.f90
@@ -62,7 +62,7 @@ program test_event_post
event post(occurrences)
!ERROR: Must be a scalar value, but is a rank-1 array
- event post(occurrences[1])
+ event post(occurrences(:)[1])
!______ invalid sync-stat-lists: invalid stat= ____________
diff --git a/flang/test/Semantics/resolve94.f90 b/flang/test/Semantics/resolve94.f90
index 75755fb2b2038..1d0b106bd1171 100644
--- a/flang/test/Semantics/resolve94.f90
+++ b/flang/test/Semantics/resolve94.f90
@@ -35,7 +35,7 @@ subroutine s1()
rVar1 = rCoarray[1,intArray,3]
! OK
rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM=team2]
- !ERROR: Team value must be of type TEAM_TYPE from module ISO_FORTRAN_ENV
+ !ERROR: TEAM= specifier must have type TEAM_TYPE from ISO_FORTRAN_ENV
rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM=2]
! OK
rVar1 = rCoarray[1,2,3,STAT=iVar1, TEAM_NUMBER=38]
@@ -48,12 +48,12 @@ subroutine s1()
!ERROR: Must be a scalar value, but is a rank-1 array
rVar1 = rCoarray[1,2,3,STAT=intArray]
! Error on C929, no specifier can appear more than once
- !ERROR: STAT variable can only be specified once
+ !ERROR: coindexed reference has multiple STAT= specifiers
rVar1 = rCoarray[1,2,3,STAT=iVar1, STAT=iVar2]
! OK
rVar1 = rCoarray[1,2,3,TEAM=team1]
! Error on C929, no specifier can appear more than once
- !ERROR: TEAM value can only be specified once
+ !ERROR: coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers
rVar1 = rCoarray[1,2,3,TEAM=team1, TEAM=team2]
! OK
rVar1 = rCoarray[1,2,3,TEAM_NUMBER=37]
@@ -66,11 +66,11 @@ subroutine s1()
!ERROR: Must have INTEGER type, but is REAL(4)
rVar1 = rCoarray[1,2,3,TEAM_NUMBER=3.7]
! Error on C929, no specifier can appear more than once
- !ERROR: TEAM_NUMBER value can only be specified once
+ !ERROR: coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers
rVar1 = rCoarray[1,2,3,TEAM_NUMBER=37, TEAM_NUMBER=37]
- !ERROR: Cannot specify both TEAM and TEAM_NUMBER
+ !ERROR: coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers
rVar1 = rCoarray[1,2,3,TEAM=team1, TEAM_NUMBER=37]
- !ERROR: Cannot specify both TEAM and TEAM_NUMBER
+ !ERROR: coindexed reference has multiple TEAM= or TEAM_NUMBER= specifiers
rVar1 = rCoarray[1,2,3,TEAM_number=43, TEAM=team1]
! OK for a STAT variable to be a coarray integer
rVar1 = rCoarray[1,2,3,stat=intScalarCoarray]
More information about the flang-commits
mailing list