[flang] Check actual/dummy coranks in more cases (#130167)

The check for equality of actual and dummy argument coranks was taking
place only for ALLOCATABLE coarrays; perform the check for all cases,
and refine the ALLOCATABLE check to apply only to cases that don't fail
the new more general check.
This commit is contained in:
Peter Klausler 2025-03-10 13:19:58 -07:00 committed by GitHub
parent bbc27fbb1c
commit fd8de7524d
No known key found for this signature in database
GPG Key ID: B5690EEEBB952194
3 changed files with 14 additions and 9 deletions

View File

@ -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) {

View File

@ -26,7 +26,7 @@ module m
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

View File

@ -41,9 +41,9 @@ module m
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