diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index b9aa4c19af9cf..774beb60fe785 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -5226,7 +5226,7 @@ bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { const auto &accessSpec{std::get>(x.t)}; const auto &genericSpec{std::get>(x.t)}; const auto &bindingNames{std::get>(x.t)}; - auto info{GenericSpecInfo{genericSpec.value()}}; + GenericSpecInfo info{genericSpec.value()}; SourceName symbolName{info.symbolName()}; bool isPrivate{accessSpec ? accessSpec->v == parser::AccessSpec::Kind::Private : derivedTypeInfo_.privateBindings}; @@ -5236,17 +5236,19 @@ bool DeclarationVisitor::Pre(const parser::TypeBoundGenericStmt &x) { genericSymbol = nullptr; // MakeTypeSymbol will report the error below } } else { - // look in parent types: - Symbol *inheritedSymbol{nullptr}; + // look in ancestor types for a generic of the same name for (const auto &name : GetAllNames(context(), symbolName)) { - inheritedSymbol = currScope().FindComponent(SourceName{name}); - if (inheritedSymbol) { + if (Symbol * inherited{currScope().FindComponent(SourceName{name})}) { + if (inherited->has()) { + CheckAccessibility(symbolName, isPrivate, *inherited); // C771 + } else { + Say(symbolName, + "Type bound generic procedure '%s' may not have the same name as a non-generic symbol inherited from an ancestor type"_err_en_US) + .Attach(inherited->name(), "Inherited symbol"_en_US); + } break; } } - if (inheritedSymbol && inheritedSymbol->has()) { - CheckAccessibility(symbolName, isPrivate, *inheritedSymbol); // C771 - } } if (genericSymbol) { CheckAccessibility(symbolName, isPrivate, *genericSymbol); // C771 diff --git a/flang/test/Semantics/resolve117.f90 b/flang/test/Semantics/resolve117.f90 new file mode 100644 index 0000000000000..3e3a813c0921b --- /dev/null +++ b/flang/test/Semantics/resolve117.f90 @@ -0,0 +1,27 @@ +! RUN: %python %S/test_errors.py %s %flang_fc1 +! Test name conflicts with type-bound generics +module m + type base1(k) + integer, kind :: k = 4 + real x + contains + procedure, nopass :: tbp => sub + generic :: gen => tbp + end type + type, extends(base1) :: ext1 + contains + procedure, nopass :: sub + !ERROR: Type parameter, component, or procedure binding 'base1' already defined in this type + generic :: base1 => sub + !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 + !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 + !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 + end type + contains + subroutine sub + end +end