[flang] Fix combining cases of USE association & generic interfaces

[klausler]

Summary

Fortran admits a few ways to have multiple symbols with the
same name in the same scope. Two of them involve generic
interfaces (from INTERFACE or GENERIC, the syntax doesn't matter);
these are allowed to inhabit a scope with either a derived type or
a subprogram that is also a specific procedure of the generic.
(But not both a derived type and a subprogram; they could not
cohabit a scope anyway, generic or not.)

In cases of USE association, f18 needs to be capable of combining
use-associated generic interfaces with other use-associated entities.
Two generics get merged (this case was nearly correct); a generic
and a derived type can merge into a GenericDetails with a shadowed
derivedType(); and a generic can replace or ignore a use-associated
procedure of the same name so long as that procedure is already
one of its specifics.

Further, these modifications to the use-associated generic
interface must be made to a local copy of the symbol. The previous
code was messing directly with the symbol in the module's scope.

The fix is basically a reimplementation of the member function
DoAddUse() in name resolution.

[jeanPerier]

LGTM

flang/lib/Semantics/resolve-names.cpp

public:
   bool Pre(const parser::Rename::Names &);
   bool Pre(const parser::Rename::Operators &);
   bool Pre(const parser::UseStmt &);
   void Post(const parser::UseStmt &);
 
   void BeginModule(const parser::Name &, bool isSubmodule);
   bool BeginSubmodule(const parser::Name &, const parser::ParentIdentifier &);
   void ApplyDefaultAccess();
-  void AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
+  Symbol &AddGenericUse(GenericDetails &, const SourceName &, const Symbol &);
   void AddAndCheckExplicitIntrinsicUse(SourceName, bool isIntrinsic);
   void ClearUseRenames() { useRenames_.clear(); }
   void ClearUseOnly() { useOnly_.clear(); }
   void ClearExplicitIntrinsicUses() {
     explicitIntrinsicUses_.clear();
     explicitNonIntrinsicUses_.clear();
   }
 
private:
   // A rename in a USE statement: local => use
   struct SymbolRename {
     Symbol *local{nullptr};
     Symbol *use{nullptr};
   };
   // Record a use from useModuleScope_ of use Name/Symbol as local Name/Symbol
   SymbolRename AddUse(const SourceName &localName, const SourceName &useName);
   SymbolRename AddUse(const SourceName &, const SourceName &, Symbol *);
-  void DoAddUse(const SourceName &, const SourceName &, Symbol &localSymbol,
-      const Symbol &useSymbol);
+  void DoAddUse(
+      SourceName, SourceName, Symbol &localSymbol, const Symbol &useSymbol);
   void AddUse(const GenericSpecInfo &);
   // If appropriate, erase a previously USE-associated symbol
   void EraseRenamedSymbol(const Symbol &);
   // Record a name appearing in a USE rename clause
   void AddUseRename(const SourceName &name) {
     useRenames_.emplace(std::make_pair(name, useModuleScope_));
   }
   bool IsUseRenamed(const SourceName &name) const {
if (auto *useDetails{symbol->detailsIf<UseDetails>()}) {
           moduleSymbol.owner() == useSymbol.owner() && IsUseRenamed(name) &&
           !IsUseOnly(name)) {
         EraseSymbol(*symbol);
       }
     }
   }
 }
 
-void ModuleVisitor::DoAddUse(const SourceName &location,
-    const SourceName &localName, Symbol &localSymbol, const Symbol &useSymbol) {
+void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
+    Symbol &localSymbol, const Symbol &useSymbol) {
   if (localName != useSymbol.name()) {
     EraseRenamedSymbol(useSymbol);
   }
-  localSymbol.attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
+  if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) {
+    details->add_occurrence(location, *useModuleScope_);
+    return;
+  }
+
+  if (localSymbol.has<UnknownDetails>()) {
+    localSymbol.set_details(UseDetails{localName, useSymbol});
+    localSymbol.attrs() =
+        useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE};
     localSymbol.flags() = useSymbol.flags();
+    return;
+  }
+
+  Symbol &localUltimate{localSymbol.GetUltimate()};
   const Symbol &useUltimate{useSymbol.GetUltimate()};
-  if (auto *useDetails{localSymbol.detailsIf<UseDetails>()}) {
-    const Symbol &localUltimate{localSymbol.GetUltimate()};
-    if (localUltimate.owner() == useUltimate.owner()) {
-      // use-associating the same symbol again -- ok
-    } else if (localUltimate.has<GenericDetails>() &&
-        useUltimate.has<GenericDetails>()) {
-      // use-associating generics with the same names: merge them into a
-      // new generic in this scope
-      auto generic1{localUltimate.get<GenericDetails>()};
-      AddGenericUse(generic1, localName, useUltimate);
-      generic1.AddUse(localSymbol);
-      // useSymbol has specific g and so does generic1
-      auto &generic2{useUltimate.get<GenericDetails>()};
-      if (generic1.derivedType() && generic2.derivedType() &&
-          generic1.derivedType() != generic2.derivedType()) {
-        Say(location,
-            "Generic interface '%s' has ambiguous derived types"
-            " from modules '%s' and '%s'"_err_en_US,
-            localSymbol.name(), GetUsedModule(*useDetails).name(),
-            useUltimate.owner().GetName().value());
-        context().SetError(localSymbol);
-      } else {
-        generic1.CopyFrom(generic2);
-      }
-      EraseSymbol(localSymbol);
-      MakeSymbol(localSymbol.name(), localSymbol.attrs(), std::move(generic1));
+  if (&localUltimate == &useUltimate) {
+    return;
+
+  auto checkAmbiguousDerivedType{[this, location, localName](
+                                     const Symbol *t1, const Symbol *t2) {
+    if (!t1 || !t2) {
+      return true;
     } else {
-      ConvertToUseError(localSymbol, location, *useModuleScope_);
-    }
-  } else if (auto *genericDetails{localSymbol.detailsIf<GenericDetails>()}) {
-    if (const auto *useDetails{useUltimate.detailsIf<GenericDetails>()}) {
-      AddGenericUse(*genericDetails, localName, useUltimate);
-      if (genericDetails->derivedType() && useDetails->derivedType() &&
-          genericDetails->derivedType() != useDetails->derivedType()) {
+      t1 = &t1->GetUltimate();
+      t2 = &t2->GetUltimate();
+      if (&t1 != &t2) {
         Say(location,
-            "Generic interface '%s' has ambiguous derived types"
-            " from modules '%s' and '%s'"_err_en_US,
-            localSymbol.name(),
-            genericDetails->derivedType()->owner().GetName().value(),
-            useDetails->derivedType()->owner().GetName().value());
+            "Generic interface '%s' has ambiguous derived types from modules '%s' and '%s'"_err_en_US,
+            localName, t1->owner().GetName().value(),
+            t2->owner().GetName().value());
+        return false;
+      }
+    }
+  }};
+
+  auto *localGeneric{localUltimate.detailsIf<GenericDetails>()};
+  const auto *useGeneric{useUltimate.detailsIf<GenericDetails>()};
+  auto combine{false};
+  if (localGeneric) {
+    if (useGeneric) {
+      if (!checkAmbiguousDerivedType(
+              localGeneric->derivedType(), useGeneric->derivedType())) {
+        return;
+      }
+      combine = true;
+    } else if (useUltimate.has<DerivedTypeDetails>()) {
+      if (checkAmbiguousDerivedType(
+              &useUltimate, localGeneric->derivedType())) {
+        combine = true;
       } else {
-        genericDetails->CopyFrom(*useDetails);
-      }
+        return;
+      }
+    } else if (&useUltimate == &BypassGeneric(localUltimate)) {
+      return; // nothing to do; used subprogram is local's specific
+  } else if (useGeneric) {
+    if (localUltimate.has<DerivedTypeDetails>()) {
+      if (checkAmbiguousDerivedType(
+              &localUltimate, useGeneric->derivedType())) {
+        combine = true;
       } else {
-      ConvertToUseError(localSymbol, location, *useModuleScope_);
+        return;
       }
-  } else if (auto *details{localSymbol.detailsIf<UseErrorDetails>()}) {
-    details->add_occurrence(location, *useModuleScope_);
-  } else if (!localSymbol.has<UnknownDetails>()) {
+    } else if (&localUltimate == &BypassGeneric(useUltimate).GetUltimate()) {
+      // Local is the specific of the used generic; replace it.
+      EraseSymbol(localSymbol);
+      Symbol &newSymbol{MakeSymbol(localName,
+          useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
+          UseDetails{localName, useUltimate})};
+      newSymbol.flags() = useSymbol.flags();
+      return;
+    }
+  }
+  if (!combine) {
+    if (localSymbol.has<UseDetails>() || localSymbol.has<GenericDetails>()) {
+      ConvertToUseError(localSymbol, location, *useModuleScope_);
+    } else {
       Say(location,
           "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
           localName)
           .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US,
               localName);
+    }
+    return;
+  }
+
+  // Two items are being use-associated from different modules
+  // to the same local name.  At least one of them must be a generic,
+  // and the other one can be a generic or a derived type.
+  // (It could also have been the specific of the generic, but those
+  // cases are handled above without needing to make a local copy of the
+  // 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);
+      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);
     } else {
-    localSymbol.set_details(UseDetails{localName, useSymbol});
+      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);
+    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);
+    newUseGeneric.set_derivedType(localSymbol);
   }
 }
 
 void ModuleVisitor::AddUse(const GenericSpecInfo &info) {
   if (useModuleScope_) {
     const auto &name{info.symbolName()};
     auto rename{AddUse(name, name, FindInScope(*useModuleScope_, name))};
     info.Resolve(rename.use);
   }
 }
 
 // Create a UseDetails symbol for this USE and add it to generic
-void ModuleVisitor::AddGenericUse(
+Symbol &ModuleVisitor::AddGenericUse(
     GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) {
-  generic.AddUse(currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol}));
+  Symbol &newSymbol{
+      currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})};
+  generic.AddUse(newSymbol);
+  return newSymbol;
 }
 
 // Enforce C1406
 void ModuleVisitor::AddAndCheckExplicitIntrinsicUse(
     SourceName name, bool isIntrinsic) {
   if (isIntrinsic) {
     if (auto iter{explicitNonIntrinsicUses_.find(name)};
         iter != explicitNonIntrinsicUses_.end()) {
if (!symbol || symbol->has<UnknownDetails>()) {
     }
   }
   if (CheckUseError(name)) {
     return std::nullopt;
   }
   symbol = &symbol->GetUltimate();
   if (auto *details{symbol->detailsIf<GenericDetails>()}) {
     if (details->derivedType()) {
-      symbol = details->derivedType();
+      symbol = &details->derivedType()->GetUltimate();
     }
   }
   if (symbol->has<DerivedTypeDetails>()) {
     return DerivedTypeSpec{name.source, *symbol};
   } else {
     Say(name, "'%s' is not a derived type"_err_en_US);
     return std::nullopt;
   }

flang/lib/Semantics/symbol.cpp

void GenericDetails::CopyFrom(const GenericDetails &from) {
   kind_ = from.kind_;
   if (from.derivedType_) {
     CHECK(!derivedType_ || derivedType_ == from.derivedType_);
     derivedType_ = from.derivedType_;
   }
   for (std::size_t i{0}; i < from.specificProcs_.size(); ++i) {
     if (std::find_if(specificProcs_.begin(), specificProcs_.end(),
             [&](const Symbol &mySymbol) {
-              return &mySymbol == &*from.specificProcs_[i];
+              return &mySymbol.GetUltimate() ==
+                  &from.specificProcs_[i]->GetUltimate();
             }) == specificProcs_.end()) {
       specificProcs_.push_back(from.specificProcs_[i]);
       bindingNames_.push_back(from.bindingNames_[i]);
     }
   }
 }
 
 // The name of the kind of details for this symbol.

flang/test/Semantics/modfile07.f90

subroutine test()
     complex :: z
     call g(x)
     call g(y)
     call g(z)
   end
 end
 !Expect: m7c.mod
 !module m7c
-! use m7b, only: g => g_real
 ! use m7a, only: g => g_integer
+! use m7b, only: g => g_real
 ! interface g
 !  procedure :: s
 ! end interface
 ! private :: s
 !contains
 ! subroutine s(x)
 !  complex(4) :: x
 ! end
subroutine test()
     complex :: z
     call g(x)
     call g(y)
     call g(z)
   end
 end
 !Expect: m8c.mod
 !module m8c
-! use m8b, only: g
 ! use m8a, only: g
+! use m8b, only: g
 ! interface g
 !  procedure :: s
 ! end interface
 ! private :: s
 !contains
 ! subroutine s(x)
 !  complex(4) :: x
 ! end

 module m10c
   use m10a
   use m10b
   interface operator(/=)
   end interface
 end
 !Expect: m10c.mod
 !module m10c
-! use m10b,only:operator(.ne.)
 ! use m10a,only:operator(.ne.)
+! use m10b,only:operator(.ne.)
 ! interface operator(.ne.)
 ! end interface
 !end
 
 module m10d
   use m10a
   use m10c
   private :: operator(<>)
 end
 !Expect: m10d.mod
 !module m10d
-! use m10c,only:operator(.ne.)
 ! use m10a,only:operator(.ne.)
+! use m10c,only:operator(.ne.)
 ! interface operator(.ne.)
 ! end interface
 ! private::operator(.ne.)
 !end
 
 module m11a
 contains
   subroutine s1()

flang/test/Semantics/resolve17.f90

module m12c
   use m12b, only: gc => gb
 end
 module m12d
   use m12a, only: g => ga
   use m12c, only: g => gc
   interface g
   end interface
 end module
+
+module m13a
+ contains
+  subroutine subr
+  end subroutine
+end module
+module m13b
+  use m13a
+  interface subr
+    module procedure subr
+  end interface
+end module
+module m13c
+  use m13a
+  use m13b
+ contains
+  subroutine test
+    call subr
+  end subroutine
+end module
+module m13d
+  use m13b
+  use m13a
+ contains
+  subroutine test
+    call subr
+  end subroutine
+end module
+
+module m14a
+  type :: foo
+    integer :: n
+  end type
+end module
+module m14b
+  interface foo
+    module procedure bar
+  end interface
+ contains
+  real function bar(x)
+    real, intent(in) :: x
+    bar = x
+  end function
+end module
+module m14c
+  use m14a
+  use m14b
+  type(foo) :: x
+end module
+module m14d
+  use m14a
+  use m14b
+  type(foo) :: x
+ contains
+  subroutine test
+    real :: y
+    y = foo(1.0)
+    x = foo(2)
+  end subroutine
+end module
+module m14e
+  use m14b
+  use m14a
+  type(foo) :: x
+ contains
+  subroutine test
+    real :: y
+    y = foo(1.0)
+    x = foo(2)
+  end subroutine
+end module
+
+module m15a
+  interface foo
+    module procedure bar
+  end interface
+ contains
+  subroutine bar
+  end subroutine
+end module
+module m15b
+  !ERROR: Cannot use-associate 'foo'; it is already declared in this scope
+  use m15a
+ contains
+  subroutine foo
+  end subroutine
+end module
+module m15c
+ contains
+  subroutine foo
+  end subroutine
+end module
+module m15d
+  use m15a
+  use m15c
+ contains
+  subroutine test
+    !ERROR: Reference to 'foo' is ambiguous
+    call foo
+  end subroutine
+end module