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

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.

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

flang/lib/Semantics/mod-file.cpp

@@ -273,10 +273,11 @@ void ModFileWriter::PutSymbol(
               }
             } 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());
               }
             }

flang/lib/Semantics/resolve-names.cpp

@@ -2859,6 +2859,9 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
       // 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))};
@@ -2873,6 +2876,19 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
       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(
@@ -2885,6 +2901,9 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
     // 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},
@@ -7134,11 +7153,14 @@ void ResolveNamesVisitor::CreateGeneric(const parser::GenericSpec &x) {
   }
   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

flang/test/Semantics/resolve17.f90

@@ -190,11 +190,13 @@ subroutine g()
 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