[flang-commits] [flang] dcf9ba8 - [flang] Fix false error for multiple defined I/O subroutines
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Tue May 24 13:51:28 PDT 2022
Author: Peter Klausler
Date: 2022-05-24T13:46:42-07:00
New Revision: dcf9ba82d99c2b4625b2e0c00c44a469048f2827
URL: https://github.com/llvm/llvm-project/commit/dcf9ba82d99c2b4625b2e0c00c44a469048f2827
DIFF: https://github.com/llvm/llvm-project/commit/dcf9ba82d99c2b4625b2e0c00c44a469048f2827.diff
LOG: [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
Added:
Modified:
flang/lib/Semantics/check-declarations.cpp
flang/test/Semantics/io11.f90
Removed:
################################################################################
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 99c6e27e714a..25f4b29b45cb 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -109,12 +109,13 @@ class CheckHelper {
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 @@ class CheckHelper {
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 @@ bool CheckHelper::CheckDioDummyIsData(
}
}
-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::CheckDioDummyIsScalar(const Symbol &subp, const Symbol &arg) {
}
}
-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 @@ void CheckHelper::CheckDefinedIoProc(const Symbol &symbol,
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
index 35ea87423764..07e93773ea3a 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -434,7 +434,6 @@ 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
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
@@ -443,7 +442,6 @@ 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
@@ -469,7 +467,6 @@ 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
subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
class(t),intent(in) :: dtv
@@ -477,7 +474,6 @@ subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
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 @@ 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
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
@@ -511,7 +506,6 @@ 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
@@ -536,7 +530,6 @@ 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
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
class(t(3)),intent(inout) :: dtv
@@ -544,7 +537,6 @@ 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
@@ -569,7 +561,6 @@ 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
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
class(t(3)),intent(inout) :: dtv
@@ -577,7 +568,6 @@ 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
@@ -602,7 +592,6 @@ 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
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
@@ -611,6 +600,38 @@ 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
More information about the flang-commits
mailing list