Skip to content

Commit b7557ab

Browse files
authored
[flang] Catch disallowed usage of coarrays in defined I/O (#129907)
Defined input/output subroutines must conform to documented interfaces that do not allow for coarray dummy arguments.
1 parent 8c53566 commit b7557ab

File tree

2 files changed

+36
-7
lines changed

2 files changed

+36
-7
lines changed

flang/lib/Semantics/check-declarations.cpp

Lines changed: 8 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -3486,7 +3486,7 @@ void CheckHelper::CheckDioDummyIsDefaultInteger(
34863486
}
34873487

34883488
void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
3489-
if (arg.Rank() > 0 || arg.Corank() > 0) {
3489+
if (arg.Rank() > 0) {
34903490
messages_.Say(arg.name(),
34913491
"Dummy argument '%s' of a defined input/output procedure must be a scalar"_err_en_US,
34923492
arg.name());
@@ -3643,6 +3643,13 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
36433643
CheckDioArgCount(*specificSubp, ioKind, dummyArgs.size());
36443644
int argCount{0};
36453645
for (auto *arg : dummyArgs) {
3646+
if (arg && arg->Corank() > 0) {
3647+
evaluate::AttachDeclaration(
3648+
messages_.Say(arg->name(),
3649+
"Dummy argument '%s' of defined input/output procedure '%s' may not be a coarray"_err_en_US,
3650+
arg->name(), ultimate.name()),
3651+
*arg);
3652+
}
36463653
switch (argCount++) {
36473654
case 0:
36483655
// dtv-type-spec, INTENT(INOUT) :: dtv

flang/test/Semantics/io11.f90

Lines changed: 28 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -57,7 +57,7 @@ module m3
5757
private
5858
contains
5959
! Error bad # of args
60-
subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
60+
subroutine unformattedReadProc(dtv, unit, iostat, iomsg, iotype)
6161
class(t), intent(inout) :: dtv
6262
integer, intent(in) :: unit
6363
integer, intent(out) :: iostat
@@ -119,7 +119,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
119119
end module m5
120120

121121
module m6
122-
interface read(formatted)
122+
interface read(formatted)
123123
procedure :: formattedReadProc
124124
end interface
125125

@@ -169,7 +169,7 @@ module m8
169169
contains
170170
subroutine formattedWriteProc(dtv, unit, iotype, vlist, iostat, iomsg)
171171
!ERROR: Dummy argument 'dtv' of a defined input/output procedure must have intent 'INTENT(IN)'
172-
class(t), intent(inout) :: dtv ! Error, must be intent(inout)
172+
class(t), intent(inout) :: dtv ! Error, must be intent(in)
173173
integer, intent(in) :: unit
174174
character(len=*), intent(in) :: iotype
175175
integer, intent(in) :: vlist(:)
@@ -195,7 +195,7 @@ subroutine formattedReadProc(dtv, unit, iotype, vlist, iostat, iomsg)
195195
!ERROR: Dummy argument 'unit' of a defined input/output procedure may not have any attributes
196196
integer, pointer, intent(in) :: unit
197197
character(len=*), intent(in) :: iotype
198-
integer, intent(in) :: vlist(:)
198+
integer, intent(in) :: vlist(:)
199199
integer, intent(out) :: iostat
200200
character(len=*), intent(inout) :: iomsg
201201

@@ -416,7 +416,7 @@ subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
416416
end module
417417

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

448448
module m20
449-
! Test read and write defined input/output procedures specified as a
449+
! Test read and write defined input/output procedures specified as a
450450
! type-bound procedure and as a generic for the same derived type
451451
type t
452452
integer c
@@ -744,3 +744,25 @@ subroutine absWrite(dtv, unit, iotype, v_list, iostat, iomsg)
744744
procedure write2
745745
end interface
746746
end
747+
748+
module m29
749+
type t
750+
end type
751+
interface write(formatted)
752+
subroutine wf(dtv, unit, iotype, v_list, iostat, iomsg)
753+
import t
754+
!ERROR: Dummy argument 'dtv' of defined input/output procedure 'wf' may not be a coarray
755+
class(t), intent(in) :: dtv[*]
756+
!ERROR: Dummy argument 'unit' of defined input/output procedure 'wf' may not be a coarray
757+
integer, intent(in) :: unit[*]
758+
!ERROR: Dummy argument 'iotype' of defined input/output procedure 'wf' may not be a coarray
759+
character(len=*), intent(in) :: iotype[*]
760+
!ERROR: Dummy argument 'v_list' of defined input/output procedure 'wf' may not be a coarray
761+
integer, intent(in) :: v_list(:)[*]
762+
!ERROR: Dummy argument 'iostat' of defined input/output procedure 'wf' may not be a coarray
763+
integer, intent(out) :: iostat[*]
764+
!ERROR: Dummy argument 'iomsg' of defined input/output procedure 'wf' may not be a coarray
765+
character(len=*), intent(inout) :: iomsg[*]
766+
end
767+
end interface
768+
end

0 commit comments

Comments
 (0)