[flang-commits] [PATCH] D145109: [flang] Catch name conflict between generic TBP and inherited non-generic

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: vdonaldson.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a reviewer: sscalpone.
Herald added a project: All.
klausler requested review of this revision.

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.


https://reviews.llvm.org/D145109

Files:
  flang/lib/Semantics/resolve-names.cpp
  flang/test/Semantics/resolve117.f90


Index: flang/test/Semantics/resolve117.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Semantics/resolve-names.cpp
===================================================================
--- flang/lib/Semantics/resolve-names.cpp
+++ flang/lib/Semantics/resolve-names.cpp
@@ -5236,7 +5236,7 @@
   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};
@@ -5246,17 +5246,19 @@
       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


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D145109.501635.patch
Type: text/x-patch
Size: 3096 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230301/e5e1e351/attachment-0001.bin>