diff --git a/flang/lib/Semantics/runtime-type-info.cpp b/flang/lib/Semantics/runtime-type-info.cpp --- a/flang/lib/Semantics/runtime-type-info.cpp +++ b/flang/lib/Semantics/runtime-type-info.cpp @@ -67,11 +67,16 @@ SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const; std::vector DescribeBindings( const Scope &dtScope, Scope &); - void DescribeGeneric(const GenericDetails &, - std::map &, const DerivedTypeSpec *); + std::map DescribeSpecialGenerics( + const Scope &dtScope, const Scope &thisScope, + const DerivedTypeSpec *) const; + void DescribeSpecialGeneric(const GenericDetails &, + std::map &, const Scope &, + const DerivedTypeSpec *) const; void DescribeSpecialProc(std::map &, const Symbol &specificOrBinding, bool isAssignment, bool isFinal, - std::optional, const DerivedTypeSpec *); + std::optional, const Scope *, + const DerivedTypeSpec *) const; void IncorporateDefinedIoGenericInterfaces( std::map &, GenericKind::DefinedIo, const Scope *, const DerivedTypeSpec *); @@ -498,7 +503,6 @@ if (!isPDTdefinitionWithKindParameters) { std::vector dataComponentSymbols; std::vector procPtrComponents; - std::map specials; for (const auto &pair : dtScope) { const Symbol &symbol{*pair.second}; auto locationRestorer{common::ScopedSet(location_, symbol.name())}; @@ -518,8 +522,7 @@ }, [&](const ProcBindingDetails &) { // handled in a later pass }, - [&](const GenericDetails &generic) { - DescribeGeneric(generic, specials, derivedTypeSpec); + [&](const GenericDetails &) { // ditto }, [&](const auto &) { common::die( @@ -565,11 +568,15 @@ evaluate::ConstantSubscripts{ static_cast(bindings.size())})); // Describe "special" bindings to defined assignments, FINAL subroutines, - // and user-defined derived type I/O subroutines. + // and user-defined derived type I/O subroutines. Defined assignments + // and I/O subroutines override any parent bindings; FINAL subroutines + // do not (the runtime will call all of them). + std::map specials{ + DescribeSpecialGenerics(dtScope, dtScope, derivedTypeSpec)}; const DerivedTypeDetails &dtDetails{dtSymbol->get()}; for (const auto &pair : dtDetails.finals()) { DescribeSpecialProc(specials, *pair.second, false /*!isAssignment*/, - true, std::nullopt, derivedTypeSpec); + true, std::nullopt, nullptr, derivedTypeSpec); } if (derivedTypeSpec) { IncorporateDefinedIoGenericInterfaces(specials, @@ -986,15 +993,33 @@ return result; } -void RuntimeTableBuilder::DescribeGeneric(const GenericDetails &generic, +std::map +RuntimeTableBuilder::DescribeSpecialGenerics(const Scope &dtScope, + const Scope &thisScope, const DerivedTypeSpec *derivedTypeSpec) const { + std::map specials; + if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) { + specials = + DescribeSpecialGenerics(*parentScope, thisScope, derivedTypeSpec); + } + for (auto pair : dtScope) { + const Symbol &symbol{*pair.second}; + if (const auto *generic{symbol.detailsIf()}) { + DescribeSpecialGeneric(*generic, specials, thisScope, derivedTypeSpec); + } + } + return specials; +} + +void RuntimeTableBuilder::DescribeSpecialGeneric(const GenericDetails &generic, std::map &specials, - const DerivedTypeSpec *derivedTypeSpec) { + const Scope &dtScope, const DerivedTypeSpec *derivedTypeSpec) const { 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, derivedTypeSpec); + false /*!final*/, std::nullopt, &dtScope, + derivedTypeSpec); } } }, @@ -1006,7 +1031,7 @@ case GenericKind::DefinedIo::WriteUnformatted: for (auto ref : generic.specificProcs()) { DescribeSpecialProc(specials, *ref, false, - false /*!final*/, io, derivedTypeSpec); + false /*!final*/, io, &dtScope, derivedTypeSpec); } break; } @@ -1019,9 +1044,13 @@ void RuntimeTableBuilder::DescribeSpecialProc( std::map &specials, const Symbol &specificOrBinding, bool isAssignment, bool isFinal, - std::optional io, - const DerivedTypeSpec *derivedTypeSpec) { + std::optional io, const Scope *dtScope, + const DerivedTypeSpec *derivedTypeSpec) const { const auto *binding{specificOrBinding.detailsIf()}; + if (binding && dtScope) { // use most recent override + binding = &DEREF(dtScope->FindComponent(specificOrBinding.name())) + .get(); + } const Symbol &specific{*(binding ? &binding->symbol() : &specificOrBinding)}; if (auto proc{evaluate::characteristics::Procedure::Characterize( specific, context_.foldingContext())}) { @@ -1123,9 +1152,10 @@ IntExpr<1>(isArgDescriptorSet)); AddValue(values, specialSchema_, "proc"s, SomeExpr{evaluate::ProcedureDesignator{specific}}); - auto pair{specials.try_emplace( - *index, DEREF(specialSchema_.AsDerived()), std::move(values))}; - CHECK(pair.second); // ensure not already present + // index might already be present in the case of an override + specials.emplace(*index, + evaluate::StructureConstructor{ + DEREF(specialSchema_.AsDerived()), std::move(values)}); } } @@ -1144,7 +1174,7 @@ definedIo); for (auto ref : genericDetails.specificProcs()) { DescribeSpecialProc( - specials, *ref, false, false, definedIo, derivedTypeSpec); + specials, *ref, false, false, definedIo, nullptr, derivedTypeSpec); } } } diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90 --- a/flang/module/__fortran_type_info.f90 +++ b/flang/module/__fortran_type_info.f90 @@ -23,7 +23,7 @@ ! "TBP" bindings appear first. Inherited bindings, with overrides already ! applied, appear in the initial entries in the same order as they ! appear in the parent type's bindings, if any. They are followed - ! by new local bindings in alphabetic order of theing binding names. + ! by new local bindings in alphabetic order of their binding names. type(Binding), pointer, contiguous :: binding(:) character(len=:), pointer :: name integer(kind=int64) :: sizeInBytes diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h --- a/flang/runtime/type-info.h +++ b/flang/runtime/type-info.h @@ -208,7 +208,7 @@ const DerivedType *GetParentType() const; - // Finds a data component by name in this derived type or tis ancestors. + // Finds a data component by name in this derived type or its ancestors. const Component *FindDataComponent( const char *name, std::size_t nameLen) const; diff --git a/flang/test/Semantics/typeinfo02.f90 b/flang/test/Semantics/typeinfo02.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Semantics/typeinfo02.f90 @@ -0,0 +1,33 @@ +!RUN: bbc --dump-symbols %s | FileCheck %s +!RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s + +module m1 + type base + contains + procedure :: wf => wf1 + generic :: write(formatted) => wf + end type + type, extends(base) :: extended + contains + procedure :: wf => wf2 + end type + contains + subroutine wf1(x,u,iot,v,iostat,iomsg) + class(base), intent(in) :: x + integer, intent(in) :: u + character(len=*), intent(in) :: iot + integer, intent(in) :: v(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + end subroutine + subroutine wf2(x,u,iot,v,iostat,iomsg) + class(extended), intent(in) :: x + integer, intent(in) :: u + character(len=*), intent(in) :: iot + integer, intent(in) :: v(:) + integer, intent(out) :: iostat + character(len=*), intent(inout) :: iomsg + end subroutine +end module +!CHECK: .s.base, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,proc=wf1)] +!CHECK: .s.extended, SAVE, TARGET (CompilerCreated, ReadOnly): ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,isargdescriptorset=1_1,proc=wf2)]