forked from OSchip/llvm-project
[flang] Check for duplicate definitions of defined input/output procedures
It's possible to specify defined input/output procedures either as a type-bound procedure of a derived type or as a defined-io-generic-spec. This means that you can specify the same procedure in both mechanisms, which does not cause problems. Alternatively, you can specify two different procedures to be the defined input/output procedure for the same derived type. This is an error. This change catches this error. The situation is slightly complicated by parameterized derived types. Types with the same value for a KIND parameter are treated as the same type while types with different KIND parameters are treated as different types. I implemented this check by adding a vector to keep track of which defined input/output procedures had been seen for which derived types along with the kind of procedure (read vs write and formatted vs unformatted). I also added tests for non-parameterized types and types parameterized by KIND and LEN type parameters. I also removed an erroneous check from the code that creates runtime type information. Differential Revision: https://reviews.llvm.org/D103560
This commit is contained in:
Peter Steinfeld
parent
83235b07e3
commit
22d7e298dc
|
|
@ -107,7 +107,8 @@ private:
|
|||
void CheckDefinedIoProc(
|
||||
const Symbol &, const GenericDetails &, GenericKind::DefinedIo);
|
||||
bool CheckDioDummyIsData(const Symbol &, const Symbol *, std::size_t);
|
||||
void CheckDioDummyIsDerived(const Symbol &, const Symbol &);
|
||||
void CheckDioDummyIsDerived(
|
||||
const Symbol &, const Symbol &, GenericKind::DefinedIo ioKind);
|
||||
void CheckDioDummyIsDefaultInteger(const Symbol &, const Symbol &);
|
||||
void CheckDioDummyIsScalar(const Symbol &, const Symbol &);
|
||||
void CheckDioDummyAttrs(const Symbol &, const Symbol &, Attr);
|
||||
|
|
@ -118,6 +119,13 @@ private:
|
|||
void CheckDioVlistArg(const Symbol &, const Symbol *, std::size_t);
|
||||
void CheckDioArgCount(
|
||||
const Symbol &, GenericKind::DefinedIo ioKind, std::size_t);
|
||||
struct TypeWithDefinedIo {
|
||||
const DerivedTypeSpec *type;
|
||||
GenericKind::DefinedIo ioKind;
|
||||
const Symbol &proc;
|
||||
};
|
||||
void CheckAlreadySeenDefinedIo(
|
||||
const DerivedTypeSpec *, GenericKind::DefinedIo, const Symbol &);
|
||||
|
||||
SemanticsContext &context_;
|
||||
evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
|
||||
|
|
@ -132,6 +140,8 @@ private:
|
|||
characterizeCache_;
|
||||
// Collection of symbols with BIND(C) names
|
||||
std::map<std::string, SymbolRef> bindC_;
|
||||
// Derived types that have defined input/output procedures
|
||||
std::vector<TypeWithDefinedIo> seenDefinedIoTypes_;
|
||||
};
|
||||
|
||||
class DistinguishabilityHelper {
|
||||
|
|
@ -1742,15 +1752,36 @@ bool CheckHelper::CheckDioDummyIsData(
|
|||
}
|
||||
}
|
||||
|
||||
void CheckHelper::CheckDioDummyIsDerived(
|
||||
const Symbol &subp, const Symbol &arg) {
|
||||
if (const DeclTypeSpec * type{arg.GetType()}; type && type->AsDerived()) {
|
||||
return;
|
||||
void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType,
|
||||
GenericKind::DefinedIo ioKind, const Symbol &proc) {
|
||||
for (TypeWithDefinedIo definedIoType : seenDefinedIoTypes_) {
|
||||
if (*derivedType == *definedIoType.type && ioKind == definedIoType.ioKind &&
|
||||
proc != definedIoType.proc) {
|
||||
SayWithDeclaration(proc, definedIoType.proc.name(),
|
||||
"Derived type '%s' already has defined input/output procedure"
|
||||
" '%s'"_err_en_US,
|
||||
derivedType->name(),
|
||||
parser::ToUpperCaseLetters(GenericKind::EnumToString(ioKind)));
|
||||
return;
|
||||
}
|
||||
}
|
||||
seenDefinedIoTypes_.emplace_back(
|
||||
TypeWithDefinedIo{derivedType, ioKind, proc});
|
||||
}
|
||||
|
||||
void CheckHelper::CheckDioDummyIsDerived(
|
||||
const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
|
||||
if (const DeclTypeSpec * type{arg.GetType()}) {
|
||||
const DerivedTypeSpec *derivedType{type->AsDerived()};
|
||||
if (derivedType) {
|
||||
CheckAlreadySeenDefinedIo(derivedType, ioKind, subp);
|
||||
} else {
|
||||
messages_.Say(arg.name(),
|
||||
"Dummy argument '%s' of a defined input/output procedure must have a"
|
||||
" derived type"_err_en_US,
|
||||
arg.name());
|
||||
}
|
||||
}
|
||||
messages_.Say(arg.name(),
|
||||
"Dummy argument '%s' of a defined input/output procedure must have a"
|
||||
" derived type"_err_en_US,
|
||||
arg.name());
|
||||
}
|
||||
|
||||
void CheckHelper::CheckDioDummyIsDefaultInteger(
|
||||
|
|
@ -1781,7 +1812,7 @@ void CheckHelper::CheckDioDtvArg(
|
|||
const Symbol &subp, const Symbol *arg, GenericKind::DefinedIo ioKind) {
|
||||
// Dtv argument looks like: dtv-type-spec, INTENT(INOUT) :: dtv
|
||||
if (CheckDioDummyIsData(subp, arg, 0)) {
|
||||
CheckDioDummyIsDerived(subp, *arg);
|
||||
CheckDioDummyIsDerived(subp, *arg, ioKind);
|
||||
CheckDioDummyAttrs(subp, *arg,
|
||||
ioKind == GenericKind::DefinedIo::ReadFormatted ||
|
||||
ioKind == GenericKind::DefinedIo::ReadUnformatted
|
||||
|
|
|
|||
|
|
@ -886,12 +886,6 @@ void RuntimeTableBuilder::DescribeSpecialProc(
|
|||
}
|
||||
} else { // user defined derived type I/O
|
||||
CHECK(proc->dummyArguments.size() >= 4);
|
||||
bool isArg0Descriptor{
|
||||
!proc->dummyArguments.at(0).CanBePassedViaImplicitInterface()};
|
||||
// N.B. When the user defined I/O subroutine is a type bound procedure,
|
||||
// its first argument is always a descriptor, otherwise, when it was an
|
||||
// interface, it never is.
|
||||
CHECK(!!binding == isArg0Descriptor);
|
||||
if (binding) {
|
||||
isArgDescriptorSet |= 1;
|
||||
}
|
||||
|
|
|
|||
|
|
@ -364,3 +364,253 @@ contains
|
|||
stop 'fail'
|
||||
end subroutine
|
||||
end module m16
|
||||
|
||||
module m17
|
||||
! Test the same defined input/output procedure specified as a generic
|
||||
type t
|
||||
integer c
|
||||
contains
|
||||
procedure :: formattedReadProc
|
||||
end type
|
||||
|
||||
interface read(formatted)
|
||||
module procedure formattedReadProc
|
||||
end interface
|
||||
|
||||
contains
|
||||
subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
|
||||
class(t),intent(inout) :: dtv
|
||||
integer,intent(in) :: unit
|
||||
character(*),intent(in) :: iotype
|
||||
integer,intent(in) :: v_list(:)
|
||||
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 m18
|
||||
! Test the same defined input/output procedure specified as a type-bound
|
||||
! procedure and as a generic
|
||||
type t
|
||||
integer c
|
||||
contains
|
||||
procedure :: formattedReadProc
|
||||
generic :: read(formatted) => formattedReadProc
|
||||
end type
|
||||
interface read(formatted)
|
||||
module procedure formattedReadProc
|
||||
end interface
|
||||
contains
|
||||
subroutine formattedReadProc(dtv,unit,iotype,v_list,iostat,iomsg)
|
||||
class(t),intent(inout) :: dtv
|
||||
integer,intent(in) :: unit
|
||||
character(*),intent(in) :: iotype
|
||||
integer,intent(in) :: v_list(:)
|
||||
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 m19
|
||||
! Test two different defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type
|
||||
type t
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc1
|
||||
generic :: read(unformatted) => unformattedReadProc1
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc
|
||||
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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
module m20
|
||||
! Test read and write defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type
|
||||
type t
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc
|
||||
generic :: read(unformatted) => unformattedReadProc
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc
|
||||
end interface
|
||||
interface write(unformatted)
|
||||
module procedure unformattedWriteProc
|
||||
end interface
|
||||
contains
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
subroutine unformattedWriteProc(dtv,unit,iostat,iomsg)
|
||||
class(t),intent(in) :: dtv
|
||||
integer,intent(in) :: unit
|
||||
integer,intent(out) :: iostat
|
||||
character(*),intent(inout) :: iomsg
|
||||
write(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c
|
||||
print *,v_list
|
||||
end subroutine
|
||||
end module
|
||||
|
||||
module m21
|
||||
! Test read and write defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type with a
|
||||
! KIND type parameter where they both have the same value
|
||||
type t(typeParam)
|
||||
integer, kind :: typeParam = 4
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc
|
||||
generic :: read(unformatted) => unformattedReadProc
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc1
|
||||
end interface
|
||||
contains
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
|
||||
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
|
||||
class(t(4)),intent(inout) :: dtv
|
||||
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
|
||||
end module
|
||||
|
||||
module m22
|
||||
! Test read and write defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type with a
|
||||
! KIND type parameter where they have different values
|
||||
type t(typeParam)
|
||||
integer, kind :: typeParam = 4
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc
|
||||
generic :: read(unformatted) => unformattedReadProc
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc1
|
||||
end interface
|
||||
contains
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
|
||||
class(t(3)),intent(inout) :: dtv
|
||||
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
|
||||
end module
|
||||
|
||||
module m23
|
||||
type t(typeParam)
|
||||
! Test read and write defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type with a
|
||||
! LEN type parameter where they have different values
|
||||
integer, len :: typeParam = 4
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc
|
||||
generic :: read(unformatted) => unformattedReadProc
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc1
|
||||
end interface
|
||||
contains
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
|
||||
class(t(3)),intent(inout) :: dtv
|
||||
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
|
||||
end module
|
||||
|
||||
module m24
|
||||
! Test read and write defined input/output procedures specified as a
|
||||
! type-bound procedure and as a generic for the same derived type with a
|
||||
! LEN type parameter where they have the same value
|
||||
type t(typeParam)
|
||||
integer, len :: typeParam = 4
|
||||
integer c
|
||||
contains
|
||||
procedure :: unformattedReadProc
|
||||
generic :: read(unformatted) => unformattedReadProc
|
||||
end type
|
||||
interface read(unformatted)
|
||||
module procedure unformattedReadProc1
|
||||
end interface
|
||||
contains
|
||||
subroutine unformattedReadProc(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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
!ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED'
|
||||
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
|
||||
print *,v_list
|
||||
end subroutine
|
||||
end module
|
||||
|
|
|
|||
Loading…
Reference in New Issue