diff --git a/flang/lib/Evaluate/variable.cpp b/flang/lib/Evaluate/variable.cpp index 841d0f71ed0e2..849194b492053 100644 --- a/flang/lib/Evaluate/variable.cpp +++ b/flang/lib/Evaluate/variable.cpp @@ -477,8 +477,11 @@ int BaseObject::Corank() const { int Component::Corank() const { if (int corank{symbol_->Corank()}; corank > 0) { return corank; + } else if (semantics::IsAllocatableOrObjectPointer(&*symbol_)) { + return 0; // coarray subobjects ca%a or ca%p are not coarrays + } else { + return base().Corank(); } - return base().Corank(); } int NamedEntity::Corank() const { @@ -489,7 +492,14 @@ int NamedEntity::Corank() const { u_); } -int ArrayRef::Corank() const { return base().Corank(); } +int ArrayRef::Corank() const { + for (const Subscript &subs : subscript_) { + if (!std::holds_alternative(subs.u) && subs.Rank() > 0) { + return 0; // vector-valued subscript - subobject is not a coarray + } + } + return base().Corank(); +} int DataRef::Corank() const { return common::visit(common::visitors{ diff --git a/flang/test/Semantics/coarrays02.f90 b/flang/test/Semantics/coarrays02.f90 index a9f4958204936..193e5f8af4e63 100644 --- a/flang/test/Semantics/coarrays02.f90 +++ b/flang/test/Semantics/coarrays02.f90 @@ -48,3 +48,25 @@ function func2() !ERROR: Local variable 'local' without the SAVE or ALLOCATABLE attribute may not have a coarray potential subobject component '%comp' type(t) :: local end + +module m3 + type t + real, allocatable :: a(:) + real, pointer :: p(:) + real arr(2) + end type + contains + subroutine sub(ca) + real, intent(in) :: ca(:)[*] + end + subroutine test(cat) + type(t), intent(in) :: cat[*] + call sub(cat%arr(1:2)) ! ok + !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray + call sub(cat%arr([1])) + !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray + call sub(cat%a) + !ERROR: Actual argument associated with coarray dummy argument 'ca=' must be a coarray + call sub(cat%p) + end +end