Skip to content

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

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 1 commit into from
Mar 10, 2025
Merged

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

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
17 changes: 11 additions & 6 deletions flang/lib/Semantics/check-call.cpp
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 &&
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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) {
Expand Down
2 changes: 1 addition & 1 deletion flang/test/Semantics/call04.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
4 changes: 2 additions & 2 deletions flang/test/Semantics/call06.f90
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down