diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index 25e9262e46a75..e5a01657e4a15 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -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()); @@ -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 diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 index 7565d35aeb407..3529929003b01 100644 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -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 @@ -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 @@ -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(:) @@ -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 @@ -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 @@ -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 @@ -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