intel/llvm
1
0
Fork 0
mirror of https://github.com/intel/llvm.git synced 2026-01-17 06:40:01 +08:00
Code Issues Packages Projects Releases Wiki Activity

[flang] Revamp evaluate::CoarrayRef (#136628)

Browse Source 
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.)
This commit is contained in:
Peter Klausler
2025-05-12 12:02:15 -07:00
committed by GitHub
parent 4086d5ff74
commit 9f8ff4b77d
29 changed files with 162 additions and 253 deletions
Download Patch File Download Diff File Expand all files Collapse all files

38
flang/include/flang/Evaluate/tools.h
View File

@@ -399,20 +399,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>
@@ -426,9 +423,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));
@@ -536,22 +530,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

3
flang/include/flang/Evaluate/traverse.h
View File

@@ -146,8 +146,7 @@ public:
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 {

41
flang/include/flang/Evaluate/variable.h
View File

@@ -98,8 +98,6 @@ private:
// 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 @@ private:
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 @@ public:
// (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

5
flang/lib/Evaluate/check-expression.cpp
View File

@@ -946,10 +946,7 @@ public:
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());

13
flang/lib/Evaluate/fold.cpp
View File

@@ -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;
}

26
flang/lib/Evaluate/formatting.cpp
View File

@@ -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 << ']';
}

15
flang/lib/Evaluate/shape.cpp
View File

@@ -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 {

15
flang/lib/Evaluate/tools.cpp
View File

@@ -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;

57
flang/lib/Evaluate/variable.cpp
View File

@@ -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);

11
flang/lib/Lower/Support/Utils.cpp
View File

@@ -70,18 +70,12 @@ public:
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 @@ public:
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());
}

29
flang/lib/Semantics/check-coarray.cpp
View File

@@ -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);
}
}

3
flang/lib/Semantics/check-coarray.h
View File

@@ -37,9 +37,6 @@ public:
private:
SemanticsContext &context_;
bool haveStat_;
bool haveTeam_;
bool haveTeamNumber_;
void CheckNamesAreDistinct(const std::list<parser::CoarrayAssociation> &);
void Say2(const parser::CharBlock &, parser::MessageFixedText &&,

1
flang/lib/Semantics/dump-expr.cpp
View File

@@ -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());

88
flang/lib/Semantics/expression.cpp
View File

@@ -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;
}

2
flang/test/Semantics/atomic02.f90
View File

@@ -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)

4
flang/test/Semantics/atomic03.f90
View File

@@ -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)

4
flang/test/Semantics/atomic04.f90
View File

@@ -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)

2
flang/test/Semantics/atomic05.f90
View File

@@ -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)

2
flang/test/Semantics/atomic06.f90
View File

@@ -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)

2
flang/test/Semantics/atomic07.f90
View File

@@ -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)

2
flang/test/Semantics/atomic08.f90
View File

@@ -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)

2
flang/test/Semantics/atomic09.f90
View File

@@ -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)

4
flang/test/Semantics/atomic10.f90
View File

@@ -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)

2
flang/test/Semantics/atomic11.f90
View File

@@ -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)

24
flang/test/Semantics/coarrays02.f90
View File

@@ -96,3 +96,27 @@ module m3
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

4
flang/test/Semantics/coshape.f90
View File

@@ -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])

2
flang/test/Semantics/error_stop1b.f90
View File

@@ -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

2
flang/test/Semantics/event01b.f90
View File

@@ -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= ____________

12
flang/test/Semantics/resolve94.f90
View File

@@ -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]