Skip to content

Commit dcf9ba8

Browse files
klauslerklausler
committed
[flang] Fix false error for multiple defined I/O subroutines
User-defined derived type I/O subroutines need to be unique for a given type and operation in any scope, but it is acceptable to have more than one defined I/O subroutine so long as only one of them is visible. Differential Revision: https://reviews.llvm.org/D126152
1 parent 48a8a3e commit dcf9ba8

File tree

2 files changed

+60
-31
lines changed

2 files changed

+60
-31
lines changed

‎flang/lib/Semantics/check-declarations.cpp

Lines changed: 27 additions & 19 deletions
Original file line numberDiff line numberDiff line change
@@ -109,12 +109,13 @@ class CheckHelper {
109109
void CheckDefinedIoProc(
110110
const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
111111
bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
112-
void CheckDioDummyIsDerived(
113-
const Symbol &, const Symbol &, GenericKind::DefinedIo ioKind);
112+
void CheckDioDummyIsDerived(const Symbol &, const Symbol &,
113+
GenericKind::DefinedIo ioKind, const Symbol &);
114114
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
115115
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
116116
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
117-
void CheckDioDtvArg(const Symbol &, const Symbol *, GenericKind::DefinedIo);
117+
void CheckDioDtvArg(
118+
const Symbol &, const Symbol *, GenericKind::DefinedIo, const Symbol &);
118119
void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &);
119120
void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr);
120121
void CheckDioAssumedLenCharacterArg(
@@ -123,12 +124,13 @@ class CheckHelper {
123124
void CheckDioArgCount(
124125
const Symbol &, GenericKind::DefinedIo ioKind, std::size_t);
125126
struct TypeWithDefinedIo {
126-
const DerivedTypeSpec *type;
127+
const DerivedTypeSpec &type;
127128
GenericKind::DefinedIo ioKind;
128129
const Symbol &proc;
130+
const Symbol &generic;
129131
};
130-
void CheckAlreadySeenDefinedIo(
131-
const DerivedTypeSpec *, GenericKind::DefinedIo, const Symbol &);
132+
void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &,
133+
GenericKind::DefinedIo, const Symbol &, const Symbol &generic);
132134

133135
SemanticsContext &context_;
134136
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -1903,28 +1905,34 @@ bool CheckHelper::CheckDioDummyIsData(
19031905
}
19041906
}
19051907

1906-
void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType,
1907-
GenericKind::DefinedIo ioKind, const Symbol &proc) {
1908+
void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType,
1909+
GenericKind::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) {
19081910
for (TypeWithDefinedIo definedIoType : seenDefinedIoTypes_) {
1909-
if (*derivedType == *definedIoType.type && ioKind == definedIoType.ioKind &&
1910-
proc != definedIoType.proc) {
1911+
// It's okay to have two or more distinct derived type I/O procedures
1912+
// for the same type if they're coming from distinct non-type-bound
1913+
// interfaces. (The non-type-bound interfaces would have been merged into
1914+
// a single generic if both were visible in the same scope.)
1915+
if (derivedType == definedIoType.type && ioKind == definedIoType.ioKind &&
1916+
proc != definedIoType.proc &&
1917+
(generic.owner().IsDerivedType() ||
1918+
definedIoType.generic.owner().IsDerivedType())) {
19111919
SayWithDeclaration(proc, definedIoType.proc.name(),
19121920
"Derived type '%s' already has defined input/output procedure"
19131921
" '%s'"_err_en_US,
1914-
derivedType->name(),
1922+
derivedType.name(),
19151923
parser::ToUpperCaseLetters(GenericKind::EnumToString(ioKind)));
19161924
return;
19171925
}
19181926
}
19191927
seenDefinedIoTypes_.emplace_back(
1920-
TypeWithDefinedIo{derivedType, ioKind, proc});
1928+
TypeWithDefinedIo{derivedType, ioKind, proc, generic});
19211929
}
19221930

1923-
void CheckHelper::CheckDioDummyIsDerived(
1924-
const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
1931+
void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg,
1932+
GenericKind::DefinedIo ioKind, const Symbol &generic) {
19251933
if (const DeclTypeSpec * type{arg.GetType()}) {
19261934
if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
1927-
CheckAlreadySeenDefinedIo(derivedType, ioKind, subp);
1935+
CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic);
19281936
bool isPolymorphic{type->IsPolymorphic()};
19291937
if (isPolymorphic != IsExtensibleType(derivedType)) {
19301938
messages_.Say(arg.name(),
@@ -1965,11 +1973,11 @@ void CheckHelper::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
19651973
}
19661974
}
19671975

1968-
void CheckHelper::CheckDioDtvArg(
1969-
const Symbol &subp, const Symbol *arg, GenericKind::DefinedIo ioKind) {
1976+
void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg,
1977+
GenericKind::DefinedIo ioKind, const Symbol &generic) {
19701978
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
19711979
if (CheckDioDummyIsData(subp, arg, 0)) {
1972-
CheckDioDummyIsDerived(subp, *arg, ioKind);
1980+
CheckDioDummyIsDerived(subp, *arg, ioKind, generic);
19731981
CheckDioDummyAttrs(subp, *arg,
19741982
ioKind == GenericKind::DefinedIo::ReadFormatted ||
19751983
ioKind == GenericKind::DefinedIo::ReadUnformatted
@@ -2107,7 +2115,7 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
21072115
switch (argCount++) {
21082116
case 0:
21092117
// dtv-type-spec, INTENT(INOUT) :: dtv
2110-
CheckDioDtvArg(specific, arg, ioKind);
2118+
CheckDioDtvArg(specific, arg, ioKind, symbol);
21112119
break;
21122120
case 1:
21132121
// INTEGER, INTENT(IN) :: unit

‎flang/test/Semantics/io11.f90

Lines changed: 33 additions & 12 deletions
Original file line numberDiff line numberDiff line change
@@ -434,7 +434,6 @@ subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
434434
integer,intent(out) :: iostat
435435
character(*),intent(inout) :: iomsg
436436
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
437-
print *,v_list
438437
end subroutine
439438
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
440439
subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
@@ -443,7 +442,6 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
443442
integer,intent(out) :: iostat
444443
character(*),intent(inout) :: iomsg
445444
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
446-
print *,v_list
447445
end subroutine
448446
end module
449447

@@ -469,15 +467,13 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
469467
integer,intent(out) :: iostat
470468
character(*),intent(inout) :: iomsg
471469
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
472-
print *,v_list
473470
end subroutine
474471
subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
475472
class(t),intent(in) :: dtv
476473
integer,intent(in) :: unit
477474
integer,intent(out) :: iostat
478475
character(*),intent(inout) :: iomsg
479476
write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
480-
print *,v_list
481477
end subroutine
482478
end module
483479

@@ -502,7 +498,6 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
502498
integer,intent(out) :: iostat
503499
character(*),intent(inout) :: iomsg
504500
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
505-
print *,v_list
506501
end subroutine
507502
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
508503
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
@@ -511,7 +506,6 @@ subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
511506
integer,intent(out) :: iostat
512507
character(*),intent(inout) :: iomsg
513508
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
514-
print *,v_list
515509
end subroutine
516510
end module
517511

@@ -536,15 +530,13 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
536530
integer,intent(out) :: iostat
537531
character(*),intent(inout) :: iomsg
538532
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
539-
print *,v_list
540533
end subroutine
541534
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
542535
class(t(3)),intent(inout) :: dtv
543536
integer,intent(in) :: unit
544537
integer,intent(out) :: iostat
545538
character(*),intent(inout) :: iomsg
546539
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
547-
print *,v_list
548540
end subroutine
549541
end module
550542

@@ -569,15 +561,13 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
569561
integer,intent(out) :: iostat
570562
character(*),intent(inout) :: iomsg
571563
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
572-
print *,v_list
573564
end subroutine
574565
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
575566
class(t(3)),intent(inout) :: dtv
576567
integer,intent(in) :: unit
577568
integer,intent(out) :: iostat
578569
character(*),intent(inout) :: iomsg
579570
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
580-
print *,v_list
581571
end subroutine
582572
end module
583573

@@ -602,7 +592,6 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
602592
integer,intent(out) :: iostat
603593
character(*),intent(inout) :: iomsg
604594
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
605-
print *,v_list
606595
end subroutine
607596
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
608597
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
@@ -611,6 +600,38 @@ subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
611600
integer,intent(out) :: iostat
612601
character(*),intent(inout) :: iomsg
613602
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
614-
print *,v_list
615603
end subroutine
616604
end module
605+
606+
module m25a
607+
! Test against false error when two defined I/O procedures exist
608+
! for the same type but are not both visible in the same scope.
609+
type t
610+
integer c
611+
end type
612+
interface read(unformatted)
613+
module procedure unformattedReadProc1
614+
end interface
615+
contains
616+
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
617+
class(t),intent(inout) :: dtv
618+
integer,intent(in) :: unit
619+
integer,intent(out) :: iostat
620+
character(*),intent(inout) :: iomsg
621+
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
622+
end subroutine
623+
end module
624+
subroutine m25b
625+
use m25a, only: t
626+
interface read(unformatted)
627+
procedure unformattedReadProc2
628+
end interface
629+
contains
630+
subroutine unformattedReadProc2(dtv,unit,iostat,iomsg)
631+
class(t),intent(inout) :: dtv
632+
integer,intent(in) :: unit
633+
integer,intent(out) :: iostat
634+
character(*),intent(inout) :: iomsg
635+
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
636+
end subroutine
637+
end subroutine

0 commit comments

Comments
 (0)