From 042c964d607f834d1a70763caa47492ba770c3c8 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Fri, 13 Jan 2023 14:33:57 -0800 Subject: [PATCH] [flang] Fix defined I/O semantics crash & missing errors that exposed it Semantics crashes when emitting runtime derived type information tables for a type that has user-defined I/O procedures declared outside the type with explicit INTERFACE blocks (as opposed to a GENERIC binding within the type). This is due to the runtime table constructor adding a table entry for each specific procedure of any explicit interface of the right kind (e.g., READ(UNFORMATTED)) that it found, rather than just the ones that pertain to the derived type in question. But semantics also wasn't checking such interfaces for distinguishable specific procedures, either. Clean these up, improve the spelling of defined I/O procedure kinds in error messages ("read(formatted)" rather than "READFORMATTED"), and make error messages stemming from macro expansions only have one "error:" prefix on the original message so that a new test would work. Differential Revision: https://reviews.llvm.org/D142769 --- flang/lib/Decimal/big-radix-floating-point.h | 4 +- flang/lib/Evaluate/characteristics.cpp | 8 ++++ flang/lib/Parser/provenance.cpp | 2 +- flang/lib/Semantics/check-declarations.cpp | 6 +-- flang/lib/Semantics/runtime-type-info.cpp | 56 +++++++++++++++++----------- flang/test/Semantics/generic05.F90 | 37 ++++++++++++++++++ flang/test/Semantics/io11.f90 | 6 +-- flang/test/Semantics/resolve65.f90 | 1 + 8 files changed, 88 insertions(+), 32 deletions(-) create mode 100644 flang/test/Semantics/generic05.F90 diff --git a/flang/lib/Decimal/big-radix-floating-point.h b/flang/lib/Decimal/big-radix-floating-point.h index 3256323..7fabc7b 100644 --- a/flang/lib/Decimal/big-radix-floating-point.h +++ b/flang/lib/Decimal/big-radix-floating-point.h @@ -9,8 +9,8 @@ #ifndef FORTRAN_DECIMAL_BIG_RADIX_FLOATING_POINT_H_ #define FORTRAN_DECIMAL_BIG_RADIX_FLOATING_POINT_H_ -// This is a helper class for use in floating-point conversions -// between binary decimal representations. It holds a multiple-precision +// This is a helper class for use in floating-point conversions between +// binary and decimal representations. It holds a multiple-precision // integer value using digits of a radix that is a large even power of ten // (10,000,000,000,000,000 by default, 10**16). These digits are accompanied // by a signed exponent that denotes multiplication by a power of ten. diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp index 535f2f2..6831cfe 100644 --- a/flang/lib/Evaluate/characteristics.cpp +++ b/flang/lib/Evaluate/characteristics.cpp @@ -1188,6 +1188,10 @@ private: // Simpler distinguishability rules for operators and assignment bool DistinguishUtils::DistinguishableOpOrAssign( const Procedure &proc1, const Procedure &proc2) const { + if ((proc1.IsFunction() && proc2.IsSubroutine()) || + (proc1.IsSubroutine() && proc2.IsFunction())) { + return true; + } auto &args1{proc1.dummyArguments}; auto &args2{proc2.dummyArguments}; if (args1.size() != args2.size()) { @@ -1203,6 +1207,10 @@ bool DistinguishUtils::DistinguishableOpOrAssign( bool DistinguishUtils::Distinguishable( const Procedure &proc1, const Procedure &proc2) const { + if ((proc1.IsFunction() && proc2.IsSubroutine()) || + (proc1.IsSubroutine() && proc2.IsFunction())) { + return true; + } auto &args1{proc1.dummyArguments}; auto &args2{proc2.dummyArguments}; auto count1{CountDummyProcedures(args1)}; diff --git a/flang/lib/Parser/provenance.cpp b/flang/lib/Parser/provenance.cpp index 355d280..5c40ab7 100644 --- a/flang/lib/Parser/provenance.cpp +++ b/flang/lib/Parser/provenance.cpp @@ -293,7 +293,7 @@ void AllSources::EmitMessage(llvm::raw_ostream &o, [&](const Macro &mac) { EmitMessage( o, origin.replaces, message, prefix, color, echoSourceLine); - EmitMessage(o, mac.definition, "in a macro defined here", prefix, + EmitMessage(o, mac.definition, "in a macro defined here", ""s, color, echoSourceLine); if (echoSourceLine) { o << "that expanded to:\n " << mac.expansion << "\n "; diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index f849bcd..7f85f83 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -1347,9 +1347,6 @@ void CheckHelper::CheckGeneric( void CheckHelper::CheckSpecificsAreDistinguishable( const Symbol &generic, const GenericDetails &details) { GenericKind kind{details.kind()}; - if (!kind.IsName()) { - return; - } DistinguishabilityHelper helper{context_}; for (const Symbol &specific : details.specificProcs()) { if (const Procedure *procedure{Characterize(specific)}) { @@ -2206,8 +2203,7 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec &derivedType, 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))); + derivedType.name(), GenericKind::AsFortran(ioKind)); return; } } diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp index 45917bf..18b701f 100644 --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -67,14 +67,14 @@ private: SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const; std::vector DescribeBindings( const Scope &dtScope, Scope &); - void DescribeGeneric( - const GenericDetails &, std::map &); + void DescribeGeneric(const GenericDetails &, + std::map &, const DerivedTypeSpec *); void DescribeSpecialProc(std::map &, const Symbol &specificOrBinding, bool isAssignment, bool isFinal, - std::optional); + std::optional, const DerivedTypeSpec *); void IncorporateDefinedIoGenericInterfaces( std::map &, GenericKind::DefinedIo, - const Scope *); + const Scope *, const DerivedTypeSpec *); // Instantiated for ParamValue and Bound template @@ -519,7 +519,7 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) { [&](const ProcBindingDetails &) { // handled in a later pass }, [&](const GenericDetails &generic) { - DescribeGeneric(generic, specials); + DescribeGeneric(generic, specials, derivedTypeSpec); }, [&](const auto &) { common::die( @@ -569,16 +569,18 @@ const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) { const DerivedTypeDetails &dtDetails{dtSymbol->get()}; for (const auto &pair : dtDetails.finals()) { DescribeSpecialProc(specials, *pair.second, false /*!isAssignment*/, - true, std::nullopt); + true, std::nullopt, derivedTypeSpec); + } + if (derivedTypeSpec) { + IncorporateDefinedIoGenericInterfaces(specials, + GenericKind::DefinedIo::ReadFormatted, &scope, derivedTypeSpec); + IncorporateDefinedIoGenericInterfaces(specials, + GenericKind::DefinedIo::ReadUnformatted, &scope, derivedTypeSpec); + IncorporateDefinedIoGenericInterfaces(specials, + GenericKind::DefinedIo::WriteFormatted, &scope, derivedTypeSpec); + IncorporateDefinedIoGenericInterfaces(specials, + GenericKind::DefinedIo::WriteUnformatted, &scope, derivedTypeSpec); } - IncorporateDefinedIoGenericInterfaces( - specials, GenericKind::DefinedIo::ReadFormatted, &scope); - IncorporateDefinedIoGenericInterfaces( - specials, GenericKind::DefinedIo::ReadUnformatted, &scope); - IncorporateDefinedIoGenericInterfaces( - specials, GenericKind::DefinedIo::WriteFormatted, &scope); - IncorporateDefinedIoGenericInterfaces( - specials, GenericKind::DefinedIo::WriteUnformatted, &scope); // Pack the special procedure bindings in ascending order of their "which" // code values, and compile a little-endian bit-set of those codes for // use in O(1) look-up at run time. @@ -985,13 +987,14 @@ RuntimeTableBuilder::DescribeBindings(const Scope &dtScope, Scope &scope) { } void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic, - std::map &specials) { + std::map &specials, + const DerivedTypeSpec *derivedTypeSpec) { common::visit(common::visitors{ [&](const GenericKind::OtherKind &k) { if (k == GenericKind::OtherKind::Assignment) { for (auto ref : generic.specificProcs()) { DescribeSpecialProc(specials, *ref, true, - false /*!final*/, std::nullopt); + false /*!final*/, std::nullopt, derivedTypeSpec); } } }, @@ -1002,8 +1005,8 @@ void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic, case GenericKind::DefinedIo::WriteFormatted: case GenericKind::DefinedIo::WriteUnformatted: for (auto ref : generic.specificProcs()) { - DescribeSpecialProc( - specials, *ref, false, false /*!final*/, io); + DescribeSpecialProc(specials, *ref, false, + false /*!final*/, io, derivedTypeSpec); } break; } @@ -1016,7 +1019,8 @@ void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic, void RuntimeTableBuilder::DescribeSpecialProc( std::map &specials, const Symbol &specificOrBinding, bool isAssignment, bool isFinal, - std::optional io) { + std::optional io, + const DerivedTypeSpec *derivedTypeSpec) { const auto *binding{specificOrBinding.detailsIf()}; const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)}; if (auto proc{evaluate::characteristics::Procedure::Characterize( @@ -1079,6 +1083,14 @@ void RuntimeTableBuilder::DescribeSpecialProc( } } else { // user defined derived type I/O CHECK(proc->dummyArguments.size() >= 4); + if (derivedTypeSpec && + !std::get( + proc->dummyArguments[0].u) + .type.type() + .IsTkCompatibleWith(evaluate::DynamicType{*derivedTypeSpec})) { + // Defined I/O specific procedure is not for this derived type. + return; + } if (binding) { isArgDescriptorSet |= 1; } @@ -1119,7 +1131,8 @@ void RuntimeTableBuilder::DescribeSpecialProc( void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces( std::map &specials, - GenericKind::DefinedIo definedIo, const Scope *scope) { + GenericKind::DefinedIo definedIo, const Scope *scope, + const DerivedTypeSpec *derivedTypeSpec) { SourceName name{GenericKind::AsFortran(definedIo)}; for (; !scope->IsGlobal(); scope = &scope->parent()) { if (auto asst{scope->find(name)}; asst != scope->end()) { @@ -1130,7 +1143,8 @@ void RuntimeTableBuilder::IncorporateDefinedIoGenericInterfaces( CHECK(std::get(genericDetails.kind().u) == definedIo); for (auto ref : genericDetails.specificProcs()) { - DescribeSpecialProc(specials, *ref, false, false, definedIo); + DescribeSpecialProc( + specials, *ref, false, false, definedIo, derivedTypeSpec); } } } diff --git a/flang/test/Semantics/generic05.F90 b/flang/test/Semantics/generic05.F90 new file mode 100644 index 0000000..5d19137 --- /dev/null +++ b/flang/test/Semantics/generic05.F90 @@ -0,0 +1,37 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Check for distinguishability of defined I/O procedures defined within +! and outside their types. +module m1 + type t1 + integer n + contains + procedure :: readt1a, readt1b + !ERROR: Generic 'read(unformatted)' may not have specific procedures 'readt1a' and 'readt1b' as their interfaces are not distinguishable + generic :: read(unformatted) => readt1a, readt1b + end type + type t2 + integer n + end type + type t3 + integer n + end type + !ERROR: Generic 'read(unformatted)' may not have specific procedures 'readt2a' and 'readt2b' as their interfaces are not distinguishable + interface read(unformatted) + module procedure :: readt1a, readt2a, readt2b, readt3 + end interface + contains +#define DEFINE_READU(name, type) \ + subroutine name(dtv, unit, iostat, iomsg); \ + class(type), intent(in out) :: dtv; \ + integer, intent(in) :: unit; \ + integer, intent(out) :: iostat; \ + character(*), intent(in out) :: iomsg; \ + read(unit, iostat=iostat, iomsg=iomsg) dtv%n; \ + end subroutine name + !ERROR: Derived type 't1' already has defined input/output procedure 'read(unformatted)' + DEFINE_READU(readt1a, t1) + DEFINE_READU(readt1b, t1) + DEFINE_READU(readt2a, t2) + DEFINE_READU(readt2b, t2) + DEFINE_READU(readt3, t3) +end module diff --git a/flang/test/Semantics/io11.f90 b/flang/test/Semantics/io11.f90 index 07e9377..3c9b8b7 100644 --- a/flang/test/Semantics/io11.f90 +++ b/flang/test/Semantics/io11.f90 @@ -435,7 +435,7 @@ contains character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c end subroutine - !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' + !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)' subroutine unformattedReadProc(dtv,unit,iostat,iomsg) class(t),intent(inout) :: dtv integer,intent(in) :: unit @@ -499,7 +499,7 @@ contains character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c end subroutine - !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' + !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)' subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) class(t(4)),intent(inout) :: dtv integer,intent(in) :: unit @@ -593,7 +593,7 @@ contains character(*),intent(inout) :: iomsg read(unit,iotype,iostat=iostat,iomsg=iomsg) dtv%c end subroutine - !ERROR: Derived type 't' already has defined input/output procedure 'READUNFORMATTED' + !ERROR: Derived type 't' already has defined input/output procedure 'read(unformatted)' subroutine unformattedReadProc1(dtv,unit,iostat,iomsg) class(t(*)),intent(inout) :: dtv integer,intent(in) :: unit diff --git a/flang/test/Semantics/resolve65.f90 b/flang/test/Semantics/resolve65.f90 index f4a8d6b..00070b8 100644 --- a/flang/test/Semantics/resolve65.f90 +++ b/flang/test/Semantics/resolve65.f90 @@ -48,6 +48,7 @@ end module m2 type :: t end type + !ERROR: Generic 'assignment(=)' may not have specific procedures 's3' and 's4' as their interfaces are not distinguishable interface assignment(=) !ERROR: In defined assignment subroutine 's1', dummy argument 'y' may not be OPTIONAL subroutine s1(x, y) -- 2.7.4