[flang] Don't lose homonymous specific when copying generic

[klausler]

Summary

Defined generic procedure interfaces are allowed to shadow non-generic
procedures of the same name in the same scope (whether or not
that non-generic procedure is a specific procedure of the generic).
When making a copy of a generic interface symbol so that it can
be locally modified or be merged with another generic, don't forget
about the homonymous non-generic procedure that it might shadow.

flang/lib/Semantics/mod-file.cpp

common::visit(
             if (symbol.owner().IsDerivedType()) {
               // generic binding
               for (const Symbol &proc : x.specificProcs()) {
                 PutGenericName(typeBindings << "generic::", symbol)
                     << "=>" << proc.name() << '\n';
               }
             } else {
               PutGeneric(symbol);
-              if (x.specific()) {
+              if (x.specific() && &x.specific()->owner() == &symbol.owner()) {
                 PutSymbol(typeBindings, *x.specific());
               }
-              if (x.derivedType()) {
+              if (x.derivedType() &&
+                  &x.derivedType()->owner() == &symbol.owner()) {
                 PutSymbol(typeBindings, *x.derivedType());
               }
             }
           },
           [&](const UseDetails &) { PutUse(symbol); },
           [](const UseErrorDetails &) {},
           [&](const ProcBindingDetails &x) {
             bool deferred{symbol.attrs().test(Attr::DEFERRED)};

flang/lib/Semantics/resolve-names.cpp

void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
   // generic.)
 
   if (localGeneric) {
     if (localSymbol.has<UseDetails>()) {
       // Create a local copy of a previously use-associated generic so that
       // it can be locally extended without corrupting the original.
       GenericDetails generic;
       generic.CopyFrom(*localGeneric);
+      if (localGeneric->specific()) {
+        generic.set_specific(*localGeneric->specific());
+      }
       EraseSymbol(localSymbol);
       Symbol &newSymbol{MakeSymbol(
           localSymbol.name(), localSymbol.attrs(), std::move(generic))};
       newSymbol.flags() = localSymbol.flags();
       localGeneric = &newSymbol.get<GenericDetails>();
       localGeneric->AddUse(localSymbol);
     }
     if (useGeneric) {
       // Combine two use-associated generics
       localSymbol.attrs() =
           useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
       localSymbol.flags() = useSymbol.flags();
       AddGenericUse(*localGeneric, localName, useUltimate);
       localGeneric->CopyFrom(*useGeneric);
+      if (useGeneric->specific()) {
+        if (!localGeneric->specific()) {
+          localGeneric->set_specific(
+              *const_cast<Symbol *>(useGeneric->specific()));
+        } else if (&localGeneric->specific()->GetUltimate() !=
+            &useGeneric->specific()->GetUltimate()) {
+          Say(location,
+              "Cannot use-associate generic interface '%s' with specific procedure of the same name when another such generic is in scope"_err_en_US,
+              localName)
+              .Attach(
+                  localSymbol.name(), "Previous USE of '%s'"_en_US, localName);
+        }
+      }
     } else {
       CHECK(useUltimate.has<DerivedTypeDetails>());
       localGeneric->set_derivedType(
           AddGenericUse(*localGeneric, localName, useUltimate));
     }
   } else {
     CHECK(useGeneric && localUltimate.has<DerivedTypeDetails>());
     CHECK(localSymbol.has<UseDetails>());
     // Create a local copy of the use-associated generic, then extend it
     // with the local derived type.
     GenericDetails generic;
     generic.CopyFrom(*useGeneric);
+    if (useGeneric->specific()) {
+      generic.set_specific(*const_cast<Symbol *>(useGeneric->specific()));
+    }
     EraseSymbol(localSymbol);
     Symbol &newSymbol{MakeSymbol(localName,
         useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
         std::move(generic))};
     newSymbol.flags() = useUltimate.flags();
     auto &newUseGeneric{newSymbol.get<GenericDetails>()};
     AddGenericUse(newUseGeneric, localName, useUltimate);
     newUseGeneric.AddUse(localSymbol);
void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
   for (const std::string &n : GetAllNames(context(), symbolName)) {
     if (auto iter{currScope().find(n)}; iter != currScope().end()) {
       existing = &*iter->second;
       break;
     }
   }
   if (existing) {
     Symbol &ultimate{existing->GetUltimate()};
-    if (const auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
+    if (auto *existingGeneric{ultimate.detailsIf<GenericDetails>()}) {
       if (const auto *existingUse{existing->detailsIf<UseDetails>()}) {
         // Create a local copy of a use associated generic so that
         // it can be locally extended without corrupting the original.
         genericDetails.CopyFrom(*existingGeneric);
+        if (existingGeneric->specific()) {
+          genericDetails.set_specific(*existingGeneric->specific());
+        }
         AddGenericUse(genericDetails, existing->name(), existingUse->symbol());
       } else if (existing == &ultimate) {
         // Extending an extant generic in the same scope
         info.Resolve(existing);
         return;
       } else {
         // Host association of a generic is handled in ResolveGeneric()
         CHECK(existing->has<HostAssocDetails>());

flang/test/Semantics/resolve17.f90

interface g
     module procedure g
   end interface
 contains
   subroutine g()
   end
 end module
 subroutine s9a
   use m9a
+  !ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such generic is in scope
   use m9b
 end
 subroutine s9b
   !ERROR: USE-associated generic 'g' may not have specific procedures 'g' and 'g' as their interfaces are not distinguishable
   use m9a
+  !ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such generic is in scope
   use m9c
 end
 
 module m10a
   interface g
     module procedure s
   end interface
   private :: s