[flang-commits] [flang] [flang] Make IsCoarray() more accurate (PR #121415)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jan 3 17:23:50 PST 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/121415
>From 8ae4586fddae2b377b25f737b64dc97c764393a2 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Tue, 31 Dec 2024 13:20:27 -0800
Subject: [PATCH] [flang] Make IsCoarray() more accurate; fix ASSOCIATE coarray
and THIS_IMAGE
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.
Last, fix the THIS_IMAGE(coarray[,team]) with no DIM=, which returns a vector
of cosubscripts for the local image's instance of a coarray, not a scalar.
---
flang/include/flang/Evaluate/call.h | 1 +
.../include/flang/Evaluate/characteristics.h | 4 ++
flang/include/flang/Evaluate/constant.h | 1 +
flang/include/flang/Evaluate/expression.h | 11 +++-
flang/include/flang/Evaluate/tools.h | 30 ++++++-----
flang/include/flang/Evaluate/variable.h | 11 ++++
flang/include/flang/Semantics/symbol.h | 44 +++++++++------
flang/lib/Evaluate/characteristics.cpp | 15 +++---
flang/lib/Evaluate/expression.cpp | 12 +++++
flang/lib/Evaluate/intrinsics.cpp | 2 +-
flang/lib/Evaluate/shape.cpp | 9 ++++
flang/lib/Evaluate/tools.cpp | 8 +--
flang/lib/Evaluate/variable.cpp | 53 +++++++++++++++++++
flang/lib/Optimizer/Builder/CMakeLists.txt | 1 +
flang/lib/Semantics/check-call.cpp | 4 +-
flang/lib/Semantics/expression.cpp | 4 +-
flang/test/Semantics/resolve94.f90 | 7 +++
flang/test/Semantics/this_image01.f90 | 16 ++++++
18 files changed, 182 insertions(+), 51 deletions(-)
diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h
index 7531d8a81e808d..63277438128ebb 100644
--- a/flang/include/flang/Evaluate/call.h
+++ b/flang/include/flang/Evaluate/call.h
@@ -250,6 +250,7 @@ class ProcedureRef {
std::optional<Expr<SubscriptInteger>> LEN() const;
int Rank() const;
+ static constexpr int Corank() { return 0; } // TODO
bool IsElemental() const { return proc_.IsElemental(); }
bool hasAlternateReturns() const { return hasAlternateReturns_; }
diff --git a/flang/include/flang/Evaluate/characteristics.h b/flang/include/flang/Evaluate/characteristics.h
index 11533a7259b055..357fc3e5952436 100644
--- a/flang/include/flang/Evaluate/characteristics.h
+++ b/flang/include/flang/Evaluate/characteristics.h
@@ -102,6 +102,10 @@ class TypeAndShape {
}
if (auto type{x.GetType()}) {
TypeAndShape result{*type, GetShape(context, x, invariantOnly)};
+ result.corank_ = GetCorank(x);
+ if (result.corank_ > 0) {
+ result.attrs_.set(Attr::Coarray);
+ }
if (type->category() == TypeCategory::Character) {
if (const auto *chExpr{UnwrapExpr<Expr<SomeCharacter>>(x)}) {
if (auto length{chExpr->LEN()}) {
diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h
index d9866a08889f35..61a814446bbfd3 100644
--- a/flang/include/flang/Evaluate/constant.h
+++ b/flang/include/flang/Evaluate/constant.h
@@ -65,6 +65,7 @@ class ConstantBounds {
~ConstantBounds();
const ConstantSubscripts &shape() const { return shape_; }
int Rank() const { return GetRank(shape_); }
+ static constexpr int Corank() { return 0; }
Constant<SubscriptInteger> SHAPE() const;
// It is possible in this representation for a constant array to have
diff --git a/flang/include/flang/Evaluate/expression.h b/flang/include/flang/Evaluate/expression.h
index 9ea037a2f7c429..04f4406fc8a2c0 100644
--- a/flang/include/flang/Evaluate/expression.h
+++ b/flang/include/flang/Evaluate/expression.h
@@ -92,6 +92,7 @@ template <typename RESULT> class ExpressionBase {
std::optional<DynamicType> GetType() const;
int Rank() const;
+ int Corank() const;
std::string AsFortran() const;
#if !defined(NDEBUG) || defined(LLVM_ENABLE_DUMP)
LLVM_DUMP_METHOD void dump() const;
@@ -190,6 +191,7 @@ class Operation {
return rank;
}
}
+ static constexpr int Corank() { return 0; }
bool operator==(const Operation &that) const {
return operand_ == that.operand_;
@@ -395,6 +397,7 @@ struct ImpliedDoIndex {
using Result = SubscriptInteger;
bool operator==(const ImpliedDoIndex &) const;
static constexpr int Rank() { return 0; }
+ static constexpr int Corank() { return 0; }
parser::CharBlock name; // nested implied DOs must use distinct names
};
@@ -441,6 +444,7 @@ template <typename RESULT> class ArrayConstructorValues {
bool operator==(const ArrayConstructorValues &) const;
static constexpr int Rank() { return 1; }
+ static constexpr int Corank() { return 0; }
template <typename A> common::NoLvalue<A> Push(A &&x) {
values_.emplace_back(std::move(x));
}
@@ -680,6 +684,7 @@ template <> class Relational<SomeType> {
int Rank() const {
return common::visit([](const auto &x) { return x.Rank(); }, u);
}
+ static constexpr int Corank() { return 0; }
llvm::raw_ostream &AsFortran(llvm::raw_ostream &o) const;
common::MapTemplate<Relational, DirectlyComparableTypes> u;
};
@@ -766,7 +771,8 @@ class StructureConstructor {
std::optional<Expr<SomeType>> Find(const Symbol &) const;
StructureConstructor &Add(const semantics::Symbol &, Expr<SomeType> &&);
- int Rank() const { return 0; }
+ static constexpr int Rank() { return 0; }
+ static constexpr int Corank() { return 0; }
DynamicType GetType() const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
@@ -820,7 +826,8 @@ using BOZLiteralConstant = typename LargestReal::Scalar::Word;
// Null pointers without MOLD= arguments are typed by context.
struct NullPointer {
constexpr bool operator==(const NullPointer &) const { return true; }
- constexpr int Rank() const { return 0; }
+ static constexpr int Rank() { return 0; }
+ static constexpr int Corank() { return 0; }
};
// Procedure pointer targets are treated as if they were typeless.
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index f586c59d46e54c..ec5fc7ab014856 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -102,22 +102,26 @@ template <typename A> bool IsAssumedRank(const A *x) {
return x && IsAssumedRank(*x);
}
-// Predicate: true when an expression is a coarray (corank > 0)
-bool IsCoarray(const ActualArgument &);
-bool IsCoarray(const Symbol &);
-template <typename A> bool IsCoarray(const A &) { return false; }
-template <typename A> bool IsCoarray(const Designator<A> &designator) {
- if (const auto *symbol{std::get_if<SymbolRef>(&designator.u)}) {
- return IsCoarray(**symbol);
- }
- return false;
+// Finds the corank of an entity, possibly packaged in various ways.
+// Unlike rank, only data references have corank > 0.
+int GetCorank(const ActualArgument &);
+static inline int GetCorank(const Symbol &symbol) { return symbol.Corank(); }
+template <typename A> int GetCorank(const A &) { return 0; }
+template <typename T> int GetCorank(const Designator<T> &designator) {
+ return designator.Corank();
}
-template <typename T> bool IsCoarray(const Expr<T> &expr) {
- return common::visit([](const auto &x) { return IsCoarray(x); }, expr.u);
+template <typename T> int GetCorank(const Expr<T> &expr) {
+ return common::visit([](const auto &x) { return GetCorank(x); }, expr.u);
}
-template <typename A> bool IsCoarray(const std::optional<A> &x) {
- return x && IsCoarray(*x);
+template <typename A> int GetCorank(const std::optional<A> &x) {
+ return x ? GetCorank(*x) : 0;
}
+template <typename A> int GetCorank(const A *x) {
+ return x ? GetCorank(*x) : 0;
+}
+
+// Predicate: true when an expression is a coarray (corank > 0)
+template <typename A> bool IsCoarray(const A &x) { return GetCorank(x) > 0; }
// Generalizing packagers: these take operations and expressions of more
// specific types and wrap them in Expr<> containers of more abstract types.
diff --git a/flang/include/flang/Evaluate/variable.h b/flang/include/flang/Evaluate/variable.h
index 9565826dbfaea4..b454d37d93e57b 100644
--- a/flang/include/flang/Evaluate/variable.h
+++ b/flang/include/flang/Evaluate/variable.h
@@ -51,6 +51,7 @@ template <typename T> struct Variable;
struct BaseObject {
EVALUATE_UNION_CLASS_BOILERPLATE(BaseObject)
int Rank() const;
+ int Corank() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
const Symbol *symbol() const {
@@ -84,6 +85,7 @@ class Component {
SymbolRef &symbol() { return symbol_; }
int Rank() const;
+ int Corank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const { return symbol_; }
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -116,6 +118,7 @@ class NamedEntity {
Component *UnwrapComponent();
int Rank() const;
+ int Corank() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
bool operator==(const NamedEntity &) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
@@ -147,6 +150,7 @@ class TypeParamInquiry {
const Symbol ¶meter() const { return parameter_; }
static constexpr int Rank() { return 0; } // always scalar
+ static constexpr int Corank() { return 0; }
bool operator==(const TypeParamInquiry &) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
@@ -224,6 +228,7 @@ class ArrayRef {
}
int Rank() const;
+ int Corank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -271,6 +276,7 @@ class CoarrayRef {
CoarrayRef &set_team(Expr<SomeInteger> &&, bool isTeamNumber = false);
int Rank() const;
+ int Corank() const { return 0; }
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
NamedEntity GetBase() const;
@@ -294,6 +300,7 @@ class CoarrayRef {
struct DataRef {
EVALUATE_UNION_CLASS_BOILERPLATE(DataRef)
int Rank() const;
+ int Corank() const;
const Symbol &GetFirstSymbol() const;
const Symbol &GetLastSymbol() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -331,6 +338,7 @@ class Substring {
Parent &parent() { return parent_; }
int Rank() const;
+ int Corank() const;
template <typename A> const A *GetParentIf() const {
return std::get_if<A>(&parent_);
}
@@ -361,6 +369,7 @@ class ComplexPart {
const DataRef &complex() const { return complex_; }
Part part() const { return part_; }
int Rank() const;
+ int Corank() const;
const Symbol &GetFirstSymbol() const { return complex_.GetFirstSymbol(); }
const Symbol &GetLastSymbol() const { return complex_.GetLastSymbol(); }
bool operator==(const ComplexPart &) const;
@@ -396,6 +405,7 @@ template <typename T> class Designator {
std::optional<DynamicType> GetType() const;
int Rank() const;
+ int Corank() const;
BaseObject GetBaseObject() const;
const Symbol *GetLastSymbol() const;
std::optional<Expr<SubscriptInteger>> LEN() const;
@@ -421,6 +431,7 @@ class DescriptorInquiry {
int dimension() const { return dimension_; }
static constexpr int Rank() { return 0; } // always scalar
+ static constexpr int Corank() { return 0; }
bool operator==(const DescriptorInquiry &) const;
llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
index 2f97efddf7f7ba..bc6abccac1bb85 100644
--- a/flang/include/flang/Semantics/symbol.h
+++ b/flang/include/flang/Semantics/symbol.h
@@ -861,23 +861,7 @@ class Symbol {
bool operator!=(const Symbol &that) const { return !(*this == that); }
int Rank() const { return RankImpl(); }
-
- int Corank() const {
- return common::visit(
- common::visitors{
- [](const SubprogramDetails &sd) {
- return sd.isFunction() ? sd.result().Corank() : 0;
- },
- [](const GenericDetails &) {
- return 0; /*TODO*/
- },
- [](const UseDetails &x) { return x.symbol().Corank(); },
- [](const HostAssocDetails &x) { return x.symbol().Corank(); },
- [](const ObjectEntityDetails &oed) { return oed.coshape().Rank(); },
- [](const auto &) { return 0; },
- },
- details_);
- }
+ int Corank() const { return CorankImpl(); }
// If there is a parent component, return a pointer to its derived type spec.
// The Scope * argument defaults to this->scope_ but should be overridden
@@ -955,6 +939,32 @@ class Symbol {
},
details_);
}
+ inline int CorankImpl(int depth = startRecursionDepth) const {
+ if (depth-- == 0) {
+ return 0;
+ }
+ return common::visit(
+ common::visitors{
+ [&](const SubprogramDetails &sd) {
+ return sd.isFunction() ? sd.result().CorankImpl(depth) : 0;
+ },
+ [](const GenericDetails &) { return 0; },
+ [&](const ProcEntityDetails &ped) {
+ const Symbol *iface{ped.procInterface()};
+ return iface ? iface->CorankImpl(depth) : 0;
+ },
+ [&](const UseDetails &x) { return x.symbol().CorankImpl(depth); },
+ [&](const HostAssocDetails &x) {
+ return x.symbol().CorankImpl(depth);
+ },
+ [](const ObjectEntityDetails &oed) { return oed.coshape().Rank(); },
+ [](const AssocEntityDetails &aed) {
+ return aed.expr() ? aed.expr()->Corank() : 0;
+ },
+ [](const auto &) { return 0; },
+ },
+ details_);
+ }
template <std::size_t> friend class Symbols;
template <class, std::size_t> friend class std::array;
};
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
index 324d6b8dde73b8..3912d1c4b47715 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -227,15 +227,14 @@ void TypeAndShape::AcquireAttrs(const semantics::Symbol &symbol) {
} else if (semantics::IsAssumedSizeArray(symbol)) {
attrs_.set(Attr::AssumedSize);
}
+ if (int n{GetCorank(symbol)}) {
+ corank_ = n;
+ attrs_.set(Attr::Coarray);
+ }
if (const auto *object{
- symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()}) {
- corank_ = object->coshape().Rank();
- if (object->IsAssumedRank()) {
- attrs_.set(Attr::AssumedRank);
- }
- if (object->IsCoarray()) {
- attrs_.set(Attr::Coarray);
- }
+ symbol.GetUltimate().detailsIf<semantics::ObjectEntityDetails>()};
+ object && object->IsAssumedRank()) {
+ attrs_.set(Attr::AssumedRank);
}
}
diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp
index 9514ac8e3f6565..759fe5bc71b691 100644
--- a/flang/lib/Evaluate/expression.cpp
+++ b/flang/lib/Evaluate/expression.cpp
@@ -113,6 +113,18 @@ template <typename A> int ExpressionBase<A>::Rank() const {
derived().u);
}
+template <typename A> int ExpressionBase<A>::Corank() const {
+ return common::visit(
+ [](const auto &x) {
+ if constexpr (common::HasMember<decltype(x), TypelessExpression>) {
+ return 0;
+ } else {
+ return x.Corank();
+ }
+ },
+ derived().u);
+}
+
DynamicType Parentheses<SomeDerived>::GetType() const {
return left().GetType().value();
}
diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp
index 28805efb177ee2..5ba947f323c9a8 100644
--- a/flang/lib/Evaluate/intrinsics.cpp
+++ b/flang/lib/Evaluate/intrinsics.cpp
@@ -958,7 +958,7 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
{{"coarray", AnyData, Rank::coarray}, RequiredDIM, OptionalTEAM},
DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
{"this_image", {{"coarray", AnyData, Rank::coarray}, OptionalTEAM},
- DefaultInt, Rank::scalar, IntrinsicClass::transformationalFunction},
+ DefaultInt, Rank::vector, IntrinsicClass::transformationalFunction},
{"this_image", {OptionalTEAM}, DefaultInt, Rank::scalar,
IntrinsicClass::transformationalFunction},
{"tiny",
diff --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index c62d0cb0ff29dd..bb21a531e0ca63 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -937,6 +937,10 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
if (!call.arguments().empty()) {
return (*this)(call.arguments()[0]);
}
+ } else if (intrinsic->name == "lcobound" || intrinsic->name == "ucobound") {
+ if (call.arguments().size() == 3 && !call.arguments().at(1).has_value()) {
+ return Shape(1, ExtentExpr{GetCorank(call.arguments().at(0))});
+ }
} else if (intrinsic->name == "matmul") {
if (call.arguments().size() == 2) {
if (auto ashape{(*this)(call.arguments()[0])}) {
@@ -1076,6 +1080,11 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
}
}
}
+ } else if (intrinsic->name == "this_image") {
+ if (call.arguments().size() == 2) {
+ // THIS_IMAGE(coarray, no DIM, [TEAM])
+ return Shape(1, ExtentExpr{GetCorank(call.arguments().at(0))});
+ }
} else if (intrinsic->name == "transpose") {
if (call.arguments().size() >= 1) {
if (auto shape{(*this)(call.arguments().at(0))}) {
diff --git a/flang/lib/Evaluate/tools.cpp b/flang/lib/Evaluate/tools.cpp
index 6299084d729b2d..6bd623a690e380 100644
--- a/flang/lib/Evaluate/tools.cpp
+++ b/flang/lib/Evaluate/tools.cpp
@@ -906,13 +906,9 @@ bool IsAssumedRank(const ActualArgument &arg) {
}
}
-bool IsCoarray(const ActualArgument &arg) {
+int GetCorank(const ActualArgument &arg) {
const auto *expr{arg.UnwrapExpr()};
- return expr && IsCoarray(*expr);
-}
-
-bool IsCoarray(const Symbol &symbol) {
- return GetAssociationRoot(symbol).Corank() > 0;
+ return GetCorank(*expr);
}
bool IsProcedureDesignator(const Expr<SomeType> &expr) {
diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp
index 707a2065ca30a7..841d0f71ed0e2f 100644
--- a/flang/lib/Evaluate/variable.cpp
+++ b/flang/lib/Evaluate/variable.cpp
@@ -465,6 +465,59 @@ template <typename T> int Designator<T>::Rank() const {
u);
}
+// Corank()
+int BaseObject::Corank() const {
+ return common::visit(common::visitors{
+ [](SymbolRef symbol) { return symbol->Corank(); },
+ [](const StaticDataObject::Pointer &) { return 0; },
+ },
+ u);
+}
+
+int Component::Corank() const {
+ if (int corank{symbol_->Corank()}; corank > 0) {
+ return corank;
+ }
+ return base().Corank();
+}
+
+int NamedEntity::Corank() const {
+ return common::visit(common::visitors{
+ [](const SymbolRef s) { return s->Corank(); },
+ [](const Component &c) { return c.Corank(); },
+ },
+ u_);
+}
+
+int ArrayRef::Corank() const { return base().Corank(); }
+
+int DataRef::Corank() const {
+ return common::visit(common::visitors{
+ [](SymbolRef symbol) { return symbol->Corank(); },
+ [](const auto &x) { return x.Corank(); },
+ },
+ u);
+}
+
+int Substring::Corank() const {
+ return common::visit(
+ common::visitors{
+ [](const DataRef &dataRef) { return dataRef.Corank(); },
+ [](const StaticDataObject::Pointer &) { return 0; },
+ },
+ parent_);
+}
+
+int ComplexPart::Corank() const { return complex_.Corank(); }
+
+template <typename T> int Designator<T>::Corank() const {
+ return common::visit(common::visitors{
+ [](SymbolRef symbol) { return symbol->Corank(); },
+ [](const auto &x) { return x.Corank(); },
+ },
+ u);
+}
+
// GetBaseObject(), GetFirstSymbol(), GetLastSymbol(), &c.
const Symbol &Component::GetFirstSymbol() const {
return base_.value().GetFirstSymbol();
diff --git a/flang/lib/Optimizer/Builder/CMakeLists.txt b/flang/lib/Optimizer/Builder/CMakeLists.txt
index 05164d41a4cb55..20e2de242cc0d1 100644
--- a/flang/lib/Optimizer/Builder/CMakeLists.txt
+++ b/flang/lib/Optimizer/Builder/CMakeLists.txt
@@ -48,6 +48,7 @@ add_flang_library(FIRBuilder
FIRDialect
FIRDialectSupport
FIRSupport
+ FortranEvaluate
HLFIRDialect
${dialect_libs}
${extension_libs}
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 597c280a6df8bc..95df34b4a1f3e9 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -1622,8 +1622,8 @@ static void CheckImage_Index(evaluate::ActualArguments &arguments,
evaluate::GetShape(arguments[1]->UnwrapExpr())}) {
if (const auto *coarrayArgSymbol{UnwrapWholeSymbolOrComponentDataRef(
arguments[0]->UnwrapExpr())}) {
- const auto coarrayArgCorank = coarrayArgSymbol->Corank();
- if (const auto subArrSize = evaluate::ToInt64(*subArrShape->front())) {
+ auto coarrayArgCorank{coarrayArgSymbol->Corank()};
+ if (auto subArrSize{evaluate::ToInt64(*subArrShape->front())}) {
if (subArrSize != coarrayArgCorank) {
messages.Say(arguments[1]->sourceLocation(),
"The size of 'SUB=' (%jd) for intrinsic 'image_index' must be equal to the corank of 'COARRAY=' (%d)"_err_en_US,
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index c2eb17c1ac8e5b..1274feb388721a 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -1506,9 +1506,9 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::CoindexedNamedObject &x) {
if (cosubsOk && !reversed.empty()) {
int numCosubscripts{static_cast<int>(cosubscripts.size())};
const Symbol &symbol{reversed.front()};
- if (numCosubscripts != symbol.Corank()) {
+ if (numCosubscripts != GetCorank(symbol)) {
Say("'%s' has corank %d, but coindexed reference has %d cosubscripts"_err_en_US,
- symbol.name(), symbol.Corank(), numCosubscripts);
+ symbol.name(), GetCorank(symbol), numCosubscripts);
}
}
for (const auto &imageSelSpec :
diff --git a/flang/test/Semantics/resolve94.f90 b/flang/test/Semantics/resolve94.f90
index e47ab4a433829b..19c06ad0d16228 100644
--- a/flang/test/Semantics/resolve94.f90
+++ b/flang/test/Semantics/resolve94.f90
@@ -17,8 +17,15 @@ subroutine s1()
intCoVar = 343
! OK
rVar1 = rCoarray[1,2,3]
+ associate (x => rCoarray)
+ rVar1 = x[1,2,3] ! also ok
+ end associate
!ERROR: 'rcoarray' has corank 3, but coindexed reference has 2 cosubscripts
rVar1 = rCoarray[1,2]
+ associate (x => rCoarray)
+ !ERROR: 'x' has corank 3, but coindexed reference has 2 cosubscripts
+ rVar1 = x[1,2]
+ end associate
!ERROR: Must have INTEGER type, but is REAL(4)
rVar1 = rCoarray[1,2,3.4]
!ERROR: Must have INTEGER type, but is REAL(4)
diff --git a/flang/test/Semantics/this_image01.f90 b/flang/test/Semantics/this_image01.f90
index 0e59aa3fa27c6b..fdcccdaeed0e39 100644
--- a/flang/test/Semantics/this_image01.f90
+++ b/flang/test/Semantics/this_image01.f90
@@ -8,6 +8,8 @@ subroutine test
type(team_type) :: coteam[*]
integer :: coscalar[*], coarray(3)[*]
save :: coteam, coscalar, coarray
+ real coarray1[*], coarray2[2,*], coarray3[2,3,*]
+ integer indices(3)
! correct calls, should produce no errors
team = get_team()
@@ -17,6 +19,10 @@ subroutine test
print *, this_image(coarray, team)
print *, this_image(coarray, 1)
print *, this_image(coarray, 1, team)
+ print *, this_image(coarray(1))
+ print *, this_image(coarray(1), team)
+ print *, this_image(coarray(1), 1)
+ print *, this_image(coarray(1), 1, team)
print *, this_image(coscalar)
print *, this_image(coscalar, team)
print *, this_image(coscalar, 1)
@@ -28,4 +34,14 @@ subroutine test
print *, team_number()
print *, team_number(team)
+ indices(1:1) = this_image(coarray1) ! ok
+ indices(1:2) = this_image(coarray2) ! ok
+ indices(1:3) = this_image(coarray3) ! ok
+ !ERROR: Dimension 1 of left-hand side has extent 2, but right-hand side has extent 1
+ indices(1:2) = this_image(coarray1)
+ !ERROR: Dimension 1 of left-hand side has extent 3, but right-hand side has extent 2
+ indices(1:3) = this_image(coarray2)
+ !ERROR: Dimension 1 of left-hand side has extent 1, but right-hand side has extent 3
+ indices(1:1) = this_image(coarray3)
+
end subroutine
More information about the flang-commits
mailing list