diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index ecc1e3d27e3bf..19902910812ed 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/flang/lib/Semantics/check-call.cpp @@ -790,6 +790,12 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "ALLOCATABLE %s must have INTENT(IN) to be associated with a coindexed actual argument"_err_en_US, dummyName); } + if (!actualIsCoindexed && actualLastSymbol && dummy.type.corank() == 0 && + actualLastSymbol->Corank() > 0) { + messages.Say( + "ALLOCATABLE %s is not a coarray but actual argument has corank %d"_err_en_US, + dummyName, actualLastSymbol->Corank()); + } } else if (evaluate::IsBareNullPointer(&actual)) { if (dummyIsOptional) { } else if (dummy.intent == common::Intent::Default && @@ -822,12 +828,6 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, "ALLOCATABLE %s must be associated with an ALLOCATABLE actual argument"_err_en_US, dummyName); } - if (!actualIsCoindexed && actualLastSymbol && - actualLastSymbol->Corank() != dummy.type.corank()) { - messages.Say( - "ALLOCATABLE %s has corank %d but actual argument has corank %d"_err_en_US, - dummyName, dummy.type.corank(), actualLastSymbol->Corank()); - } } // 15.5.2.7 -- dummy is POINTER @@ -926,6 +926,11 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy, messages.Say( "Actual argument associated with coarray %s must be a coarray"_err_en_US, dummyName); + } else if (actualType.corank() != dummy.type.corank() && + dummyIsAllocatableOrPointer) { + messages.Say( + "ALLOCATABLE or POINTER %s has corank %d but actual argument has corank %d"_err_en_US, + dummyName, dummy.type.corank(), actualType.corank()); } if (dummyIsVolatile) { if (!actualIsVolatile) { diff --git a/flang/test/Semantics/call04.f90 b/flang/test/Semantics/call04.f90 index 3b079aa4fb2b1..8a99ceee6b637 100644 --- a/flang/test/Semantics/call04.f90 +++ b/flang/test/Semantics/call04.f90 @@ -26,7 +26,7 @@ subroutine s01c(x) end subroutine subroutine s01b ! C846 - can only be caught at a call via explicit interface !ERROR: ALLOCATABLE coarray 'coarray' may not be associated with INTENT(OUT) dummy argument 'x=' - !ERROR: ALLOCATABLE dummy argument 'x=' has corank 0 but actual argument has corank 1 + !ERROR: ALLOCATABLE dummy argument 'x=' is not a coarray but actual argument has corank 1 call s01a(coarray) call s01c(coarray) ! ok, dummy is not allocatable end subroutine diff --git a/flang/test/Semantics/call06.f90 b/flang/test/Semantics/call06.f90 index 3e3c5aa61b570..2a4dfc45ea927 100644 --- a/flang/test/Semantics/call06.f90 +++ b/flang/test/Semantics/call06.f90 @@ -41,9 +41,9 @@ subroutine test(x) call s01(allofunc()) ! subtle: ALLOCATABLE function result isn't call s02(cov) ! ok call s03(com) ! ok - !ERROR: ALLOCATABLE dummy argument 'x=' has corank 1 but actual argument has corank 2 + !ERROR: ALLOCATABLE or POINTER dummy argument 'x=' has corank 1 but actual argument has corank 2 call s02(com) - !ERROR: ALLOCATABLE dummy argument 'x=' has corank 2 but actual argument has corank 1 + !ERROR: ALLOCATABLE or POINTER dummy argument 'x=' has corank 2 but actual argument has corank 1 call s03(cov) call s04(cov[1]) ! ok !ERROR: ALLOCATABLE dummy argument 'x=' must have INTENT(IN) to be associated with a coindexed actual argument