From 8ae4586fddae2b377b25f737b64dc97c764393a2 Mon Sep 17 00:00:00 2001 From: Peter Klausler 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 7531d8a81e808..63277438128eb 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/flang/include/flang/Evaluate/call.h @@ -250,6 +250,7 @@ class ProcedureRef { std::optional> 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 11533a7259b05..357fc3e595243 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>(x)}) { if (auto length{chExpr->LEN()}) { diff --git a/flang/include/flang/Evaluate/constant.h b/flang/include/flang/Evaluate/constant.h index d9866a08889f3..61a814446bbfd 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 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 9ea037a2f7c42..04f4406fc8a2c 100644 --- a/flang/include/flang/Evaluate/expression.h +++ b/flang/include/flang/Evaluate/expression.h @@ -92,6 +92,7 @@ template class ExpressionBase { std::optional 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 class ArrayConstructorValues { bool operator==(const ArrayConstructorValues &) const; static constexpr int Rank() { return 1; } + static constexpr int Corank() { return 0; } template common::NoLvalue Push(A &&x) { values_.emplace_back(std::move(x)); } @@ -680,6 +684,7 @@ template <> class Relational { 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 u; }; @@ -766,7 +771,8 @@ class StructureConstructor { std::optional> Find(const Symbol &) const; StructureConstructor &Add(const semantics::Symbol &, Expr &&); - 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 f586c59d46e54..ec5fc7ab01485 100644 --- a/flang/include/flang/Evaluate/tools.h +++ b/flang/include/flang/Evaluate/tools.h @@ -102,22 +102,26 @@ template 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 bool IsCoarray(const A &) { return false; } -template bool IsCoarray(const Designator &designator) { - if (const auto *symbol{std::get_if(&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 int GetCorank(const A &) { return 0; } +template int GetCorank(const Designator &designator) { + return designator.Corank(); } -template bool IsCoarray(const Expr &expr) { - return common::visit([](const auto &x) { return IsCoarray(x); }, expr.u); +template int GetCorank(const Expr &expr) { + return common::visit([](const auto &x) { return GetCorank(x); }, expr.u); } -template bool IsCoarray(const std::optional &x) { - return x && IsCoarray(*x); +template int GetCorank(const std::optional &x) { + return x ? GetCorank(*x) : 0; } +template int GetCorank(const A *x) { + return x ? GetCorank(*x) : 0; +} + +// Predicate: true when an expression is a coarray (corank > 0) +template 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 9565826dbfaea..b454d37d93e57 100644 --- a/flang/include/flang/Evaluate/variable.h +++ b/flang/include/flang/Evaluate/variable.h @@ -51,6 +51,7 @@ template struct Variable; struct BaseObject { EVALUATE_UNION_CLASS_BOILERPLATE(BaseObject) int Rank() const; + int Corank() const; std::optional> 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> LEN() const; @@ -116,6 +118,7 @@ class NamedEntity { Component *UnwrapComponent(); int Rank() const; + int Corank() const; std::optional> 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> LEN() const; @@ -271,6 +276,7 @@ class CoarrayRef { CoarrayRef &set_team(Expr &&, 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> LEN() const; @@ -331,6 +338,7 @@ class Substring { Parent &parent() { return parent_; } int Rank() const; + int Corank() const; template const A *GetParentIf() const { return std::get_if(&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 class Designator { std::optional GetType() const; int Rank() const; + int Corank() const; BaseObject GetBaseObject() const; const Symbol *GetLastSymbol() const; std::optional> 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 2f97efddf7f7b..bc6abccac1bb8 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 friend class Symbols; template friend class std::array; }; diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 324d6b8dde73b..3912d1c4b4771 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()}) { - corank_ = object->coshape().Rank(); - if (object->IsAssumedRank()) { - attrs_.set(Attr::AssumedRank); - } - if (object->IsCoarray()) { - attrs_.set(Attr::Coarray); - } + symbol.GetUltimate().detailsIf()}; + object && object->IsAssumedRank()) { + attrs_.set(Attr::AssumedRank); } } diff --git a/flang/lib/Evaluate/expression.cpp b/flang/lib/Evaluate/expression.cpp index 9514ac8e3f656..759fe5bc71b69 100644 --- a/flang/lib/Evaluate/expression.cpp +++ b/flang/lib/Evaluate/expression.cpp @@ -113,6 +113,18 @@ template int ExpressionBase::Rank() const { derived().u); } +template int ExpressionBase::Corank() const { + return common::visit( + [](const auto &x) { + if constexpr (common::HasMember) { + return 0; + } else { + return x.Corank(); + } + }, + derived().u); +} + DynamicType Parentheses::GetType() const { return left().GetType().value(); } diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp index 28805efb177ee..5ba947f323c9a 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 c62d0cb0ff29d..bb21a531e0ca6 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 6299084d729b2..6bd623a690e38 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 &expr) { diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index 707a2065ca30a..841d0f71ed0e2 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -465,6 +465,59 @@ template int Designator::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 int Designator::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 05164d41a4cb5..20e2de242cc0d 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 597c280a6df8b..95df34b4a1f3e 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 c2eb17c1ac8e5..1274feb388721 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(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 e47ab4a433829..19c06ad0d1622 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 0e59aa3fa27c6..fdcccdaeed0e3 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