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(
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()};
}
}
-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(),
}
}
-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
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
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)
integer,intent(out) :: iostat
character(*),intent(inout) :: iomsg
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
- print *,v_list
end subroutine
end module
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
integer,intent(out) :: iostat
character(*),intent(inout) :: iomsg
write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
- print *,v_list
end subroutine
end module
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)
integer,intent(out) :: iostat
character(*),intent(inout) :: iomsg
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
- print *,v_list
end subroutine
end module
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
integer,intent(out) :: iostat
character(*),intent(inout) :: iomsg
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
- print *,v_list
end subroutine
end module
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
integer,intent(out) :: iostat
character(*),intent(inout) :: iomsg
read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
- print *,v_list
end subroutine
end module
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)
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