diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp index bf4dc16a15b4a..36704575d961d 100644 --- a/flang/lib/Semantics/check-declarations.cpp +++ b/flang/lib/Semantics/check-declarations.cpp @@ -33,6 +33,8 @@ using characteristics::DummyProcedure; using characteristics::FunctionResult; using characteristics::Procedure; +class DistinguishabilityHelper; + class CheckHelper { public: explicit CheckHelper(SemanticsContext &c) : context_{c} {} @@ -89,6 +91,8 @@ class CheckHelper { const SourceName &, const Symbol &, const Procedure &, std::size_t); bool CheckDefinedAssignment(const Symbol &, const Procedure &); bool CheckDefinedAssignmentArg(const Symbol &, const DummyArgument &, int); + void CollectSpecifics( + DistinguishabilityHelper &, const Symbol &, const GenericDetails &); void CheckSpecifics(const Symbol &, const GenericDetails &); void CheckEquivalenceSet(const EquivalenceSet &); void CheckEquivalenceObject(const EquivalenceObject &); @@ -1857,10 +1861,9 @@ void CheckHelper::CheckGeneric( } // Check that the specifics of this generic are distinguishable from each other -void CheckHelper::CheckSpecifics( +void CheckHelper::CollectSpecifics(DistinguishabilityHelper &helper, const Symbol &generic, const GenericDetails &details) { GenericKind kind{details.kind()}; - DistinguishabilityHelper helper{context_}; for (const Symbol &specific : details.specificProcs()) { if (specific.attrs().test(Attr::ABSTRACT)) { if (auto *msg{messages_.Say(generic.name(), @@ -1915,6 +1918,23 @@ void CheckHelper::CheckSpecifics( } } } + if (const Scope * parent{generic.owner().GetDerivedTypeParent()}) { + if (const Symbol * inherited{parent->FindComponent(generic.name())}) { + if (IsAccessible(*inherited, generic.owner().parent())) { + if (const auto *details{inherited->detailsIf()}) { + // Include specifics of inherited generic of the same name, too + CollectSpecifics(helper, *inherited, *details); + } + } + } + } +} + +void CheckHelper::CheckSpecifics( + const Symbol &generic, const GenericDetails &details) { + GenericKind kind{details.kind()}; + DistinguishabilityHelper helper{context_}; + CollectSpecifics(helper, generic, details); helper.Check(generic.owner()); } @@ -3884,10 +3904,11 @@ evaluate::Shape SubprogramMatchHelper::FoldShape(const evaluate::Shape &shape) { } void DistinguishabilityHelper::Add(const Symbol &generic, GenericKind kind, - const Symbol &ultimateSpecific, const Procedure &procedure) { - if (!context_.HasError(ultimateSpecific)) { + const Symbol &specific, const Procedure &procedure) { + const Symbol &ultimate{specific.GetUltimate()}; + if (!context_.HasError(ultimate)) { nameToSpecifics_[generic.name()].emplace( - &ultimateSpecific, ProcedureInfo{kind, procedure}); + &ultimate, ProcedureInfo{kind, procedure}); } } @@ -3902,6 +3923,18 @@ void DistinguishabilityHelper::Check(const Scope &scope) { const auto &[ultimate, procInfo]{*iter1}; const auto &[kind, proc]{procInfo}; for (auto iter2{iter1}; ++iter2 != info.end();) { + if (&*ultimate == &*iter2->first) { + continue; // ok, actually the same procedure + } else if (const auto *binding1{ + ultimate->detailsIf()}) { + if (const auto *binding2{ + iter2->first->detailsIf()}) { + if (&binding1->symbol().GetUltimate() == + &binding2->symbol().GetUltimate()) { + continue; // ok, bindings resolve identically + } + } + } auto distinguishable{kind.IsName() ? evaluate::characteristics::Distinguishable : evaluate::characteristics::DistinguishableOpOrAssign}; diff --git a/flang/test/Semantics/generic07.f90 b/flang/test/Semantics/generic07.f90 index e7486c02a7d2b..5566c0f82633d 100644 --- a/flang/test/Semantics/generic07.f90 +++ b/flang/test/Semantics/generic07.f90 @@ -74,7 +74,7 @@ program test interface distinguishable3 procedure :: s1a, s1b end interface - !ERROR: Generic 'indistinguishable' may not have specific procedures 's2b' and 's2a' as their interfaces are not distinguishable + !ERROR: Generic 'indistinguishable' may not have specific procedures 's2a' and 's2b' as their interfaces are not distinguishable interface indistinguishable procedure :: s2a, s2b end interface diff --git a/flang/test/Semantics/resolve117.f90 b/flang/test/Semantics/resolve117.f90 index 3e3a813c0921b..b7b0ce7db6b0e 100644 --- a/flang/test/Semantics/resolve117.f90 +++ b/flang/test/Semantics/resolve117.f90 @@ -5,23 +5,28 @@ module m integer, kind :: k = 4 real x contains - procedure, nopass :: tbp => sub - generic :: gen => tbp + procedure, nopass :: tbp => sub1 + generic :: gen1 => tbp + generic :: gen2 => tbp end type type, extends(base1) :: ext1 contains - procedure, nopass :: sub + procedure, nopass :: sub1, sub2 !ERROR: Type parameter, component, or procedure binding 'base1' already defined in this type - generic :: base1 => sub + generic :: base1 => sub1 !ERROR: Type bound generic procedure 'k' may not have the same name as a non-generic symbol inherited from an ancestor type - generic :: k => sub + generic :: k => sub1 !ERROR: Type bound generic procedure 'x' may not have the same name as a non-generic symbol inherited from an ancestor type - generic :: x => sub + generic :: x => sub1 !ERROR: Type bound generic procedure 'tbp' may not have the same name as a non-generic symbol inherited from an ancestor type - generic :: tbp => sub - generic :: gen => sub ! ok + generic :: tbp => sub1 + generic :: gen1 => sub1 ! ok + !ERROR: Generic 'gen2' may not have specific procedures 'tbp' and 'sub2' as their interfaces are not distinguishable + generic :: gen2 => sub2 end type contains - subroutine sub + subroutine sub1 + end + subroutine sub2 end end