[flang-commits] [flang] 042c964 - [flang] Fix defined I/O semantics crash & missing errors that exposed it
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Sun Jan 29 10:15:39 PST 2023
Author: Peter Klausler
Date: 2023-01-29T10:15:27-08:00
New Revision: 042c964d607f834d1a70763caa47492ba770c3c8
URL: https://github.com/llvm/llvm-project/commit/042c964d607f834d1a70763caa47492ba770c3c8
DIFF: https://github.com/llvm/llvm-project/commit/042c964d607f834d1a70763caa47492ba770c3c8.diff
LOG: [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
Added:
flang/test/Semantics/generic05.F90
Modified:
flang/lib/Decimal/big-radix-floating-point.h
flang/lib/Evaluate/characteristics.cpp
flang/lib/Parser/provenance.cpp
flang/lib/Semantics/check-declarations.cpp
flang/lib/Semantics/runtime-type-info.cpp
flang/test/Semantics/io11.f90
flang/test/Semantics/resolve65.f90
Removed:
################################################################################
diff --git a/flang/lib/Decimal/big-radix-floating-point.h b/flang/lib/Decimal/big-radix-floating-point.h
index 32563235a76cb..7fabc7bb0fce2 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 535f2f2158c1c..6831cfead727a 100644
--- a/flang/lib/Evaluate/characteristics.cpp
+++ b/flang/lib/Evaluate/characteristics.cpp
@@ -1188,6 +1188,10 @@ class DistinguishUtils {
// 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 355d280504a7c..5c40ab7bb433a 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 f849bcd5ed6d2..7f85f83c79f4e 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 45917bf35c4fc..18b701f0b66a9 100644
--- a/flang/lib/Semantics/runtime-type-info.cpp
+++ b/flang/lib/Semantics/runtime-type-info.cpp
@@ -67,14 +67,14 @@ class RuntimeTableBuilder {
SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
std::vector<evaluate::StructureConstructor> DescribeBindings(
const Scope &dtScope, Scope &);
- void DescribeGeneric(
- const GenericDetails &, std::map<int, evaluate::StructureConstructor> &);
+ void DescribeGeneric(const GenericDetails &,
+ std::map<int, evaluate::StructureConstructor> &, const DerivedTypeSpec *);
void DescribeSpecialProc(std::map<int, evaluate::StructureConstructor> &,
const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
- std::optional<GenericKind::DefinedIo>);
+ std::optional<GenericKind::DefinedIo>, const DerivedTypeSpec *);
void IncorporateDefinedIoGenericInterfaces(
std::map<int, evaluate::StructureConstructor> &, GenericKind::DefinedIo,
- const Scope *);
+ const Scope *, const DerivedTypeSpec *);
// Instantiated for ParamValue and Bound
template <typename A>
@@ -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<DerivedTypeDetails>()};
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<int, evaluate::StructureConstructor> &specials) {
+ std::map<int, evaluate::StructureConstructor> &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<int, evaluate::StructureConstructor> &specials,
const Symbol &specificOrBinding, bool isAssignment, bool isFinal,
- std::optional<GenericKind::DefinedIo> io) {
+ std::optional<GenericKind::DefinedIo> io,
+ const DerivedTypeSpec *derivedTypeSpec) {
const auto *binding{specificOrBinding.detailsIf<ProcBindingDetails>()};
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<evaluate::characteristics::DummyDataObject>(
+ 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<int, evaluate::StructureConstructor> &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<GenericKind::DefinedIo>(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 0000000000000..5d19137f301be
--- /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 07e93773ea3a8..3c9b8b7f35849 100644
--- a/flang/test/Semantics/io11.f90
+++ b/flang/test/Semantics/io11.f90
@@ -435,7 +435,7 @@ subroutine unformattedReadProc1(dtv,unit,iostat,iomsg)
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 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
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 @@ subroutine unformattedReadProc(dtv,unit,iostat,iomsg)
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 f4a8d6b9e41f3..00070b8ca8fb7 100644
--- a/flang/test/Semantics/resolve65.f90
+++ b/flang/test/Semantics/resolve65.f90
@@ -48,6 +48,7 @@ subroutine assign_t4(x, y)
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)
More information about the flang-commits
mailing list