diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -109,12 +109,13 @@ void CheckDefinedIoProc( const Symbol &, const GenericDetails &, GenericKind::DefinedIo); bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t); - void CheckDioDummyIsDerived( - const Symbol &, const Symbol &, GenericKind::DefinedIo ioKind); + void CheckDioDummyIsDerived(const Symbol &, const Symbol &, + GenericKind::DefinedIo ioKind, const Symbol &); void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &); void CheckDioDummyIsScalar(const Symbol &, const Symbol &); void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr); - void CheckDioDtvArg(const Symbol &, const Symbol *, GenericKind::DefinedIo); + void CheckDioDtvArg( + const Symbol &, const Symbol *, GenericKind::DefinedIo, const Symbol &); void CheckGenericVsIntrinsic(const Symbol &, const GenericDetails &); void CheckDefaultIntegerArg(const Symbol &, const Symbol *, Attr); void CheckDioAssumedLenCharacterArg( @@ -123,12 +124,13 @@ void CheckDioArgCount( const Symbol &, GenericKind::DefinedIo ioKind, std::size_t); struct TypeWithDefinedIo { - const DerivedTypeSpec *type; + const DerivedTypeSpec &type; GenericKind::DefinedIo ioKind; const Symbol &proc; + const Symbol &generic; }; - void CheckAlreadySeenDefinedIo( - const DerivedTypeSpec *, GenericKind::DefinedIo, const Symbol &); + void CheckAlreadySeenDefinedIo(const DerivedTypeSpec &, + GenericKind::DefinedIo, const Symbol &, const Symbol &generic); SemanticsContext &context_; evaluate::FoldingContext &foldingContext_{context_.foldingContext()}; @@ -1903,28 +1905,34 @@ } } -void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType, - GenericKind::DefinedIo ioKind, const Symbol &proc) { +void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType, + GenericKind::DefinedIo ioKind, const Symbol &proc, const Symbol &generic) { for (TypeWithDefinedIo definedIoType : seenDefinedIoTypes_) { - if (*derivedType == *definedIoType.type && ioKind == definedIoType.ioKind && - proc != definedIoType.proc) { + // It's okay to have two or more distinct derived type I/O procedures + // for the same type if they're coming from distinct non-type-bound + // interfaces. (The non-type-bound interfaces would have been merged into + // a single generic if both were visible in the same scope.) + if (derivedType == definedIoType.type && ioKind == definedIoType.ioKind && + proc != definedIoType.proc && + (generic.owner().IsDerivedType() || + definedIoType.generic.owner().IsDerivedType())) { SayWithDeclaration(proc, definedIoType.proc.name(), "Derived type '%s' already has defined input/output procedure" " '%s'"_err_en_US, - derivedType->name(), + derivedType.name(), parser::ToUpperCaseLetters(GenericKind::EnumToString(ioKind))); return; } } seenDefinedIoTypes_.emplace_back( - TypeWithDefinedIo{derivedType, ioKind, proc}); + TypeWithDefinedIo{derivedType, ioKind, proc, generic}); } -void CheckHelper::CheckDioDummyIsDerived( - const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) { +void CheckHelper::CheckDioDummyIsDerived(const Symbol &subp, const Symbol &arg, + GenericKind::DefinedIo ioKind, const Symbol &generic) { if (const DeclTypeSpec * type{arg.GetType()}) { if (const DerivedTypeSpec * derivedType{type->AsDerived()}) { - CheckAlreadySeenDefinedIo(derivedType, ioKind, subp); + CheckAlreadySeenDefinedIo(*derivedType, ioKind, subp, generic); bool isPolymorphic{type->IsPolymorphic()}; if (isPolymorphic != IsExtensibleType(derivedType)) { messages_.Say(arg.name(), @@ -1965,11 +1973,11 @@ } } -void CheckHelper::CheckDioDtvArg( - const Symbol &subp, const Symbol *arg, GenericKind::DefinedIo ioKind) { +void CheckHelper::CheckDioDtvArg(const Symbol &subp, const Symbol *arg, + GenericKind::DefinedIo ioKind, const Symbol &generic) { // Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv if (CheckDioDummyIsData(subp, arg, 0)) { - CheckDioDummyIsDerived(subp, *arg, ioKind); + CheckDioDummyIsDerived(subp, *arg, ioKind, generic); CheckDioDummyAttrs(subp, *arg, ioKind == GenericKind::DefinedIo::ReadFormatted || ioKind == GenericKind::DefinedIo::ReadUnformatted @@ -2107,7 +2115,7 @@ switch (argCount++) { case 0: // dtv-type-spec, INTENT(INOUT) :: dtv - CheckDioDtvArg(specific, arg, ioKind); + CheckDioDtvArg(specific, arg, ioKind, symbol); break; case 1: // INTEGER, INTENT(IN) :: unit diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -434,7 +434,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' subroutine unformattedReadProc(dtv,unit,iostat,iomsg) @@ -443,7 +442,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module @@ -469,7 +467,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine subroutine unformattedWriteProc(dtv,unit,iostat,iomsg) class(t),intent(in) :: dtv @@ -477,7 +474,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module @@ -502,7 +498,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) @@ -511,7 +506,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module @@ -536,7 +530,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) class(t(3)),intent(inout) :: dtv @@ -544,7 +537,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module @@ -569,7 +561,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) class(t(3)),intent(inout) :: dtv @@ -577,7 +568,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module @@ -602,7 +592,6 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) @@ -611,6 +600,38 @@ integer,intent(out) :: iostat character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c - print *,v_list end subroutine end module + +module m25a + ! Test against false error when two defined I/O procedures exist + ! for the same type but are not both visible in the same scope. + type t + integer c + end type + interface read(unformatted) + module procedure unformattedReadProc1 + end interface + contains + subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) + class(t),intent(inout) :: dtv + integer,intent(in) :: unit + integer,intent(out) :: iostat + character(*),intent(inout) :: iomsg + read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c + end subroutine +end module +subroutine m25b + use m25a, only: t + interface read(unformatted) + procedure unformattedReadProc2 + end interface + contains + subroutine unformattedReadProc2(dtv,unit,iostat,iomsg) + class(t),intent(inout) :: dtv + integer,intent(in) :: unit + integer,intent(out) :: iostat + character(*),intent(inout) :: iomsg + read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c + end subroutine +end subroutine