[flang-commits] [flang] 2216c4c - [flang] Catch name conflict between generic TBP and inherited non-generic

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2023-03-02T10:10:37-08:00
New Revision: 2216c4c6a4e29a945af75f02b9a733ac5b016ed7

URL: https://github.com/llvm/llvm-project/commit/2216c4c6a4e29a945af75f02b9a733ac5b016ed7
DIFF: https://github.com/llvm/llvm-project/commit/2216c4c6a4e29a945af75f02b9a733ac5b016ed7.diff

LOG: [flang] Catch name conflict between generic TBP and inherited non-generic

A generic procedure binding in an extended derived type may not have the
same name as a symbol inherited from an ancestor type unless that inherited
symbol is also a generic TBP.  Since generic names can be things like
"ASSIGNMENT(=)", name resolution doesn't use OkToAddComponent() for
generic TBPs, which would have caught this error as it does for other
symbols in derived types, so it must be special-cased.

Differential Revision: https://reviews.llvm.org/D145109

Added: 
    flang/test/Semantics/resolve117.f90

Modified: 
    flang/lib/Semantics/resolve-names.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index b9aa4c19af9c..774beb60fe78 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<std::optional<parser::AccessSpec>>(x.t)};
   const auto &genericSpec{std::get<Indirection<parser::GenericSpec>>(x.t)};
   const auto &bindingNames{std::get<std::list<parser::Name>>(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<GenericDetails>()) {
+          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<GenericDetails>()) {
-      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 000000000000..3e3a813c0921
--- /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