Skip to content

Commit 99b8e3c

Browse files
klauslerklausler
committed
[flang] Make IsCoarray() more accurate; fix ASSOCIATE coarray
A designator without cosubscripts can have subscripts, component references, substrings, &c. and still have corank. The current IsCoarray() predicate only seems to work for whole variable/component references. This was breaking some cases of THIS_IMAGE(). Further, when checking the number of cosubscripts in a coarray reference, allow for the possibility that the coarray might be an ASSOCIATE construct entity.
1 parent 40ac34c commit 99b8e3c

File tree

10 files changed

+104
-29
lines changed

10 files changed

+104
-29
lines changed

‎flang/include/flang/Evaluate/characteristics.h‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -102,6 +102,10 @@ class TypeAndShape {
102102
}
103103
if (auto type{x.GetType()}) {
104104
TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
105+
result.corank_ = GetCorank(x);
106+
if (result.corank_ > 0) {
107+
result.attrs_.set(Attr::Coarray);
108+
}
105109
if (type->category() == TypeCategory::Character) {
106110
if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
107111
if (auto length{chExpr->LEN()}) {

‎flang/include/flang/Evaluate/tools.h‎

Lines changed: 12 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -102,23 +102,22 @@ template <typename A> bool IsAssumedRank(const A *x) {
102102
return x && IsAssumedRank(*x);
103103
}
104104

105-
// Predicate: true when an expression is a coarray (corank > 0)
106-
bool IsCoarray(const ActualArgument &);
107-
bool IsCoarray(const Symbol &);
108-
template <typename A> bool IsCoarray(const A &) { return false; }
109-
template <typename A> bool IsCoarray(const Designator<A> &designator) {
110-
if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
111-
return IsCoarray(**symbol);
112-
}
113-
return false;
105+
int GetCorank(const ActualArgument &);
106+
int GetCorank(const Symbol &);
107+
template <typename A> int GetCorank(const A &) { return 0; }
108+
template <typename T> int GetCorank(const Designator<T> &designator) {
109+
return designator.Corank();
114110
}
115-
template <typename T> bool IsCoarray(const Expr<T> &expr) {
116-
return common::visit([](const auto &x) { return IsCoarray(x); }, expr.u);
111+
template <typename T> int GetCorank(const Expr<T> &expr) {
112+
return common::visit([](const auto &x) { return GetCorank(x); }, expr.u);
117113
}
118-
template <typename A> bool IsCoarray(const std::optional<A> &x) {
119-
return x && IsCoarray(*x);
114+
template <typename A> int GetCorank(const std::optional<A> &x) {
115+
return x ? GetCorank(*x) : 0;
120116
}
121117

118+
// Predicate: true when an expression is a coarray (corank > 0)
119+
template <typename A> bool IsCoarray(const A &x) { return GetCorank(x) > 0; }
120+
122121
// Generalizing packagers: these take operations and expressions of more
123122
// specific types and wrap them in Expr<> containers of more abstract types.
124123

‎flang/include/flang/Evaluate/variable.h‎

Lines changed: 9 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -51,6 +51,7 @@ template <typename T> struct Variable;
5151
struct BaseObject {
5252
EVALUATE_UNION_CLASS_BOILERPLATE(BaseObject)
5353
int Rank() const;
54+
int Corank() const;
5455
std::optional<Expr<SubscriptInteger>> LEN() const;
5556
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
5657
const Symbol *symbol() const {
@@ -84,6 +85,7 @@ class Component {
8485
SymbolRef &symbol() { return symbol_; }
8586

8687
int Rank() const;
88+
int Corank() const;
8789
const Symbol &GetFirstSymbol() const;
8890
const Symbol &GetLastSymbol() const { return symbol_; }
8991
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -116,6 +118,7 @@ class NamedEntity {
116118
Component *UnwrapComponent();
117119

118120
int Rank() const;
121+
int Corank() const;
119122
std::optional<Expr<SubscriptInteger>> LEN() const;
120123
bool operator==(const NamedEntity &) const;
121124
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
@@ -224,6 +227,7 @@ class ArrayRef {
224227
}
225228

226229
int Rank() const;
230+
int Corank() const;
227231
const Symbol &GetFirstSymbol() const;
228232
const Symbol &GetLastSymbol() const;
229233
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -271,6 +275,7 @@ class CoarrayRef {
271275
CoarrayRef &set_team(Expr<SomeInteger> &&, bool isTeamNumber = false);
272276

273277
int Rank() const;
278+
int Corank() const { return 0; }
274279
const Symbol &GetFirstSymbol() const;
275280
const Symbol &GetLastSymbol() const;
276281
NamedEntity GetBase() const;
@@ -294,6 +299,7 @@ class CoarrayRef {
294299
struct DataRef {
295300
EVALUATE_UNION_CLASS_BOILERPLATE(DataRef)
296301
int Rank() const;
302+
int Corank() const;
297303
const Symbol &GetFirstSymbol() const;
298304
const Symbol &GetLastSymbol() const;
299305
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -331,6 +337,7 @@ class Substring {
331337
Parent &parent() { return parent_; }
332338

333339
int Rank() const;
340+
int Corank() const;
334341
template <typename A> const A *GetParentIf() const {
335342
return std::get_if<A>(&parent_);
336343
}
@@ -361,6 +368,7 @@ class ComplexPart {
361368
const DataRef &complex() const { return complex_; }
362369
Part part() const { return part_; }
363370
int Rank() const;
371+
int Corank() const;
364372
const Symbol &GetFirstSymbol() const { return complex_.GetFirstSymbol(); }
365373
const Symbol &GetLastSymbol() const { return complex_.GetLastSymbol(); }
366374
bool operator==(const ComplexPart &) const;
@@ -396,6 +404,7 @@ template <typename T> class Designator {
396404

397405
std::optional<DynamicType> GetType() const;
398406
int Rank() const;
407+
int Corank() const;
399408
BaseObject GetBaseObject() const;
400409
const Symbol *GetLastSymbol() const;
401410
std::optional<Expr<SubscriptInteger>> LEN() const;

‎flang/lib/Evaluate/characteristics.cpp‎

Lines changed: 7 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -227,15 +227,14 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
227227
} else if (semantics::IsAssumedSizeArray(symbol)) {
228228
attrs_.set(Attr::AssumedSize);
229229
}
230+
if (int n{GetCorank(symbol)}) {
231+
corank_ = n;
232+
attrs_.set(Attr::Coarray);
233+
}
230234
if (const auto *object{
231-
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
232-
corank_ = object->coshape().Rank();
233-
if (object->IsAssumedRank()) {
234-
attrs_.set(Attr::AssumedRank);
235-
}
236-
if (object->IsCoarray()) {
237-
attrs_.set(Attr::Coarray);
238-
}
235+
symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
236+
object && object->IsAssumedRank()) {
237+
attrs_.set(Attr::AssumedRank);
239238
}
240239
}
241240

‎flang/lib/Evaluate/tools.cpp‎

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -906,13 +906,13 @@ bool IsAssumedRank(const ActualArgument &arg) {
906906
}
907907
}
908908

909-
bool IsCoarray(const ActualArgument &arg) {
909+
int GetCorank(const ActualArgument &arg) {
910910
const auto *expr{arg.UnwrapExpr()};
911-
return expr && IsCoarray(*expr);
911+
return expr ? GetCorank(*expr) : 0;
912912
}
913913

914-
bool IsCoarray(const Symbol &symbol) {
915-
return GetAssociationRoot(symbol).Corank() > 0;
914+
int GetCorank(const Symbol &symbol) {
915+
return GetAssociationRoot(symbol).Corank();
916916
}
917917

918918
bool IsProcedureDesignator(const Expr<SomeType> &expr) {

‎flang/lib/Evaluate/variable.cpp‎

Lines changed: 53 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -465,6 +465,59 @@ template <typename T> int Designator<T>::Rank() const {
465465
u);
466466
}
467467

468+
// Corank()
469+
int BaseObject::Corank() const {
470+
return common::visit(common::visitors{
471+
[](SymbolRef symbol) { return symbol->Corank(); },
472+
[](const StaticDataObject::Pointer &) { return 0; },
473+
},
474+
u);
475+
}
476+
477+
int Component::Corank() const {
478+
if (int corank{symbol_->Corank()}; corank > 0) {
479+
return corank;
480+
}
481+
return base().Corank();
482+
}
483+
484+
int NamedEntity::Corank() const {
485+
return common::visit(common::visitors{
486+
[](const SymbolRef s) { return s->Corank(); },
487+
[](const Component &c) { return c.Corank(); },
488+
},
489+
u_);
490+
}
491+
492+
int ArrayRef::Corank() const { return base().Corank(); }
493+
494+
int DataRef::Corank() const {
495+
return common::visit(common::visitors{
496+
[](SymbolRef symbol) { return symbol->Corank(); },
497+
[](const auto &x) { return x.Corank(); },
498+
},
499+
u);
500+
}
501+
502+
int Substring::Corank() const {
503+
return common::visit(
504+
common::visitors{
505+
[](const DataRef &dataRef) { return dataRef.Corank(); },
506+
[](const StaticDataObject::Pointer &) { return 0; },
507+
},
508+
parent_);
509+
}
510+
511+
int ComplexPart::Corank() const { return complex_.Corank(); }
512+
513+
template <typename T> int Designator<T>::Corank() const {
514+
return common::visit(common::visitors{
515+
[](SymbolRef symbol) { return symbol->Corank(); },
516+
[](const auto &x) { return x.Corank(); },
517+
},
518+
u);
519+
}
520+
468521
// GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c.
469522
const Symbol &Component::GetFirstSymbol() const {
470523
return base_.value().GetFirstSymbol();

‎flang/lib/Semantics/check-call.cpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1622,8 +1622,8 @@ static void CheckImage_Index(evaluate::ActualArguments &arguments,
16221622
evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
16231623
if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
16241624
arguments[0]->UnwrapExpr())}) {
1625-
const auto coarrayArgCorank = coarrayArgSymbol->Corank();
1626-
if (const auto subArrSize = evaluate::ToInt64(*subArrShape->front())) {
1625+
auto coarrayArgCorank{coarrayArgSymbol->Corank()};
1626+
if (auto subArrSize{evaluate::ToInt64(*subArrShape->front())}) {
16271627
if (subArrSize != coarrayArgCorank) {
16281628
messages.Say(arguments[1]->sourceLocation(),
16291629
"The size of 'SUB=' (%jd) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (%d)"_err_en_US,

‎flang/lib/Semantics/expression.cpp‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1506,9 +1506,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
15061506
if (cosubsOk && !reversed.empty()) {
15071507
int numCosubscripts{static_cast<int>(cosubscripts.size())};
15081508
const Symbol &symbol{reversed.front()};
1509-
if (numCosubscripts != symbol.Corank()) {
1509+
if (numCosubscripts != GetCorank(symbol)) {
15101510
Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
1511-
symbol.name(), symbol.Corank(), numCosubscripts);
1511+
symbol.name(), GetCorank(symbol), numCosubscripts);
15121512
}
15131513
}
15141514
for (const auto &imageSelSpec :

‎flang/test/Semantics/resolve94.f90‎

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,8 +17,15 @@ subroutine s1()
1717
intCoVar = 343
1818
! OK
1919
rVar1 = rCoarray[1,2,3]
20+
associate (x => rCoarray)
21+
rVar1 = x[1,2,3] ! also ok
22+
end associate
2023
!ERROR: 'rcoarray' has corank 3, but coindexed reference has 2 cosubscripts
2124
rVar1 = rCoarray[1,2]
25+
associate (x => rCoarray)
26+
!ERROR: 'x' has corank 3, but coindexed reference has 2 cosubscripts
27+
rVar1 = x[1,2]
28+
end associate
2229
!ERROR: Must have INTEGER type, but is REAL(4)
2330
rVar1 = rCoarray[1,2,3.4]
2431
!ERROR: Must have INTEGER type, but is REAL(4)

‎flang/test/Semantics/this_image01.f90‎

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -17,6 +17,10 @@ subroutine test
1717
print *, this_image(coarray, team)
1818
print *, this_image(coarray, 1)
1919
print *, this_image(coarray, 1, team)
20+
print *, this_image(coarray(1))
21+
print *, this_image(coarray(1), team)
22+
print *, this_image(coarray(1), 1)
23+
print *, this_image(coarray(1), 1, team)
2024
print *, this_image(coscalar)
2125
print *, this_image(coscalar, team)
2226
print *, this_image(coscalar, 1)

0 commit comments

Comments
 (0)