Skip to content

[flang] Catch disallowed usage of coarrays in defined I/O #129907

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.

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
Show file tree
Hide file tree
Changes from all commits
Commits
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
9 changes: 8 additions & 1 deletion flang/lib/Semantics/check-declarations.cpp
Original file line number Diff line number Diff line change
Expand Up @@ -3486,7 +3486,7 @@ void CheckHelper::CheckDioDummyIsDefaultInteger(
}

void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
if (arg.Rank() > 0 || arg.Corank() > 0) {
if (arg.Rank() > 0) {
messages_.Say(arg.name(),
"Dummy argument '%s' of a defined input/output procedure must be a scalar"_err_en_US,
arg.name());
Expand Down Expand Up @@ -3643,6 +3643,13 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
int argCount{0};
for (auto *arg : dummyArgs) {
if (arg && arg->Corank() > 0) {
evaluate::AttachDeclaration(
messages_.Say(arg->name(),
"Dummy argument '%s' of defined input/output procedure '%s' may not be a coarray"_err_en_US,
arg->name(), ultimate.name()),
*arg);
}
switch (argCount++) {
case 0:
// dtv-type-spec, INTENT(INOUT) :: dtv
Expand Down
34 changes: 28 additions & 6 deletions flang/test/Semantics/io11.f90
Original file line number Diff line number Diff line change
Expand Up @@ -57,7 +57,7 @@ module m3
private
contains
! Error bad # of args
subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
class(t), intent(inout) :: dtv
integer, intent(in) :: unit
integer, intent(out) :: iostat
Expand Down Expand Up @@ -119,7 +119,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
end module m5

module m6
interface read(formatted)
interface read(formatted)
procedure :: formattedReadProc
end interface

Expand Down Expand Up @@ -169,7 +169,7 @@ module m8
contains
subroutine formattedWriteProc(dtv, unit, iotype, vlist, iostat, iomsg)
!ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(IN)'
class(t), intent(inout) :: dtv ! Error, must be intent(inout)
class(t), intent(inout) :: dtv ! Error, must be intent(in)
integer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
Expand All @@ -195,7 +195,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
!ERROR: Dummy argument 'unit' of a defined input/output procedure may not have any attributes
integer, pointer, intent(in) :: unit
character(len=*), intent(in) :: iotype
integer, intent(in) :: vlist(:)
integer, intent(in) :: vlist(:)
integer, intent(out) :: iostat
character(len=*), intent(inout) :: iomsg

Expand Down Expand Up @@ -416,7 +416,7 @@ subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
end module

module m19
! Test two different defined input/output procedures specified as a
! Test two different defined input/output procedures specified as a
! type-bound procedure and as a generic for the same derived type
type t
integer c
Expand Down Expand Up @@ -446,7 +446,7 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
end module

module m20
! Test read and write defined input/output procedures specified as a
! Test read and write defined input/output procedures specified as a
! type-bound procedure and as a generic for the same derived type
type t
integer c
Expand Down Expand Up @@ -744,3 +744,25 @@ subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
procedure write2
end interface
end

module m29
type t
end type
interface write(formatted)
subroutine wf(dtv, unit, iotype, v_list, iostat, iomsg)
import t
!ERROR: Dummy argument 'dtv' of defined input/output procedure 'wf' may not be a coarray
class(t), intent(in) :: dtv[*]
!ERROR: Dummy argument 'unit' of defined input/output procedure 'wf' may not be a coarray
integer, intent(in) :: unit[*]
!ERROR: Dummy argument 'iotype' of defined input/output procedure 'wf' may not be a coarray
character(len=*), intent(in) :: iotype[*]
!ERROR: Dummy argument 'v_list' of defined input/output procedure 'wf' may not be a coarray
integer, intent(in) :: v_list(:)[*]
!ERROR: Dummy argument 'iostat' of defined input/output procedure 'wf' may not be a coarray
integer, intent(out) :: iostat[*]
!ERROR: Dummy argument 'iomsg' of defined input/output procedure 'wf' may not be a coarray
character(len=*), intent(inout) :: iomsg[*]
end
end interface
end