[flang] Fix edge case in USE-associated generics

[klausler]

Summary

It is generally an error when a USE-associated name clashes
with a name defined locally, but not in all cases; a generic
interface can be both USE-associated and locally defined.
This works, but not when there is also a local subprogram
with the same name, which is valid when that subprogram is
a specific of the local generic. A bogus error issues at
the point of the USE because name resolution will have already
defined a symbol for the local subprogram.

The solution is to collect the names of local generics when
creating the program tree, and then create their symbols as
well if their names are also local subprograms, prior to any
USE association processing.

[PeteSteinfeld]

All builds and tests correctly and looks good.

[alexgatea]

Just want to give you a heads-up that there are 3 LIT failures for to this commit:
TestCases/Linux/asan_dlopen_test.cpp
TestCases/Integer/sub-overflow.cpp
TestCases/Integer/uadd-overflow.cpp
Please investigate.

[klausler]

In D119566#3316356, @alexgatea wrote:

Just want to give you a heads-up that there are 3 LIT failures for to this commit:
TestCases/Linux/asan_dlopen_test.cpp
TestCases/Integer/sub-overflow.cpp
TestCases/Integer/uadd-overflow.cpp
Please investigate.

I don't recognize those as tests in flang; do you have a link to the failures? It is highly unlikely that a change to Fortran semantics would affect any test not involving flang.

[alexgatea]

I don't recognize those as tests in flang; do you have a link to the failures? It is highly unlikely that a change to Fortran semantics would affect any test not involving flang.

The issue has been resolved with a later commit that I hadn't pulled at the time. Please ignore my original comment. Sorry about this.

flang/lib/Semantics/program-tree.h

 
 namespace Fortran::semantics {
 
 class Scope;
 
 class ProgramTree {
 public:
   using EntryStmtList = std::list<common::Reference<const parser::EntryStmt>>;
+  using GenericSpecList =
+      std::list<common::Reference<const parser::GenericSpec>>;
 
   // Build the ProgramTree rooted at one of these program units.
   static ProgramTree Build(const parser::ProgramUnit &);
   static ProgramTree Build(const parser::MainProgram &);
   static ProgramTree Build(const parser::FunctionSubprogram &);
   static ProgramTree Build(const parser::SubroutineSubprogram &);
   static ProgramTree Build(const parser::SeparateModuleSubprogram &);
   static ProgramTree Build(const parser::Module &);
public:
   void set_isSpecificationPartResolved(bool yes = true) {
     isSpecificationPartResolved_ = yes;
   }
   const parser::ParentIdentifier &GetParentId() const; // only for Submodule
   const parser::SpecificationPart &spec() const { return spec_; }
   const parser::ExecutionPart *exec() const { return exec_; }
   std::list<ProgramTree> &children() { return children_; }
   const std::list<ProgramTree> &children() const { return children_; }
-  const std::list<common::Reference<const parser::EntryStmt>> &
-  entryStmts() const {
-    return entryStmts_;
-  }
+  const EntryStmtList &entryStmts() const { return entryStmts_; }
+  const GenericSpecList &genericSpecs() const { return genericSpecs_; }
+
   Symbol::Flag GetSubpFlag() const;
   bool IsModule() const; // Module or Submodule
   bool HasModulePrefix() const; // in function or subroutine stmt
   Scope *scope() const { return scope_; }
   void set_scope(Scope &);
   void AddChild(ProgramTree &&);
   void AddEntry(const parser::EntryStmt &);
+  void AddGeneric(const parser::GenericSpec &);
 
   template <typename T>
   ProgramTree &set_stmt(const parser::Statement<T> &stmt) {
     stmt_ = &stmt;
     return *this;
   }
   template <typename T>
   ProgramTree &set_endStmt(const parser::Statement<T> &stmt) {
     endStmt_ = &stmt.source;
     return *this;
   }
 
 private:
   const parser::Name &name_;
   Stmt stmt_{
       static_cast<const parser::Statement<parser::ProgramStmt> *>(nullptr)};
   const parser::SpecificationPart &spec_;
   const parser::ExecutionPart *exec_{nullptr};
   std::list<ProgramTree> children_;
   EntryStmtList entryStmts_;
+  GenericSpecList genericSpecs_;
   Scope *scope_{nullptr};
   const parser::CharBlock *endStmt_{nullptr};
   bool isSpecificationPartResolved_{false};
 };
 
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_PROGRAM_TREE_H_

flang/lib/Semantics/program-tree.cpp

for (const auto &epConstruct : exec.v) {
     if (const auto *entryStmt{std::get_if<
             parser::Statement<common::Indirection<parser::EntryStmt>>>(
             &epConstruct.u)}) {
       node.AddEntry(entryStmt->statement.value());
     }
   }
 }
 
+// Collects generics that define simple names that could include
+// identically-named subprograms as specific procedures.
+static void GetGenerics(
+    ProgramTree &node, const parser::SpecificationPart &spec) {
+  for (const auto &decl :
+      std::get<std::list<parser::DeclarationConstruct>>(spec.t)) {
+    if (const auto *spec{
+            std::get_if<parser::SpecificationConstruct>(&decl.u)}) {
+      if (const auto *generic{std::get_if<
+              parser::Statement<common::Indirection<parser::GenericStmt>>>(
+              &spec->u)}) {
+        const parser::GenericStmt &genericStmt{generic->statement.value()};
+        const auto &genericSpec{std::get<parser::GenericSpec>(genericStmt.t)};
+        node.AddGeneric(genericSpec);
+      } else if (const auto *interface{
+                     std::get_if<common::Indirection<parser::InterfaceBlock>>(
+                         &spec->u)}) {
+        const parser::InterfaceBlock &interfaceBlock{interface->value()};
+        const parser::InterfaceStmt &interfaceStmt{
+            std::get<parser::Statement<parser::InterfaceStmt>>(interfaceBlock.t)
+                .statement};
+        const auto *genericSpec{
+            std::get_if<std::optional<parser::GenericSpec>>(&interfaceStmt.u)};
+        if (genericSpec && genericSpec->has_value()) {
+          node.AddGeneric(**genericSpec);
+        }
+      }
+    }
+  }
+}
+
 template <typename T>
 static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   const auto &exec{std::get<parser::ExecutionPart>(x.t)};
   const auto &subps{
       std::get<std::optional<parser::InternalSubprogramPart>>(x.t)};
   ProgramTree node{name, spec, &exec};
   GetEntryStmts(node, spec);
   GetEntryStmts(node, exec);
+  GetGenerics(node, spec);
   if (subps) {
     for (const auto &subp :
         std::get<std::list<parser::InternalSubprogram>>(subps->t)) {
       std::visit(
           [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
           subp.u);
     }
   }
   return node;
 }
 
 static ProgramTree BuildSubprogramTree(
     const parser::Name &name, const parser::BlockData &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   return ProgramTree{name, spec};
 }
 
 template <typename T>
 static ProgramTree BuildModuleTree(const parser::Name &name, const T &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
   const auto &subps{std::get<std::optional<parser::ModuleSubprogramPart>>(x.t)};
   ProgramTree node{name, spec};
+  GetGenerics(node, spec);
   if (subps) {
     for (const auto &subp :
         std::get<std::list<parser::ModuleSubprogram>>(subps->t)) {
       std::visit(
           [&](const auto &y) { node.AddChild(ProgramTree::Build(y.value())); },
           subp.u);
     }
   }

 void ProgramTree::AddChild(ProgramTree &&child) {
   children_.emplace_back(std::move(child));
 }
 
 void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
   entryStmts_.emplace_back(entryStmt);
 }
 
+void ProgramTree::AddGeneric(const parser::GenericSpec &generic) {
+  genericSpecs_.emplace_back(generic);
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/resolve-names.cpp

for (auto &child : node.children()) {
     for (const auto &entryStmt : child.entryStmts()) {
       SubprogramNameDetails details{kind, child};
       details.set_isEntryStmt();
       auto &symbol{
           MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
       symbol.set(child.GetSubpFlag());
     }
   }
+  for (const auto &generic : node.genericSpecs()) {
+    if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {
+      if (currScope().find(name->source) != currScope().end()) {
+        // If this scope has both a generic interface and a contained
+        // subprogram with the same name, create the generic's symbol
+        // now so that any other generics of the same name that are pulled
+        // into scope later via USE association will properly merge instead
+        // of raising a bogus error due a conflict with the subprogram.
+        CreateGeneric(*generic);
+      }
+    }
+  }
 }
 
 // Push a new scope for this node or return false on error.
 bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
   switch (node.GetKind()) {
     SWITCH_COVERS_ALL_CASES
   case ProgramTree::Kind::Program:
     PushScope(Scope::Kind::MainProgram,

flang/test/Semantics/resolve18.f90

interface f13
     function f13()
     end function f13
   end interface f13
 contains
   !ERROR: 'f13' is already declared in this scoping unit
   function f13()
   end function f13
 end module m13
+
+! Not an error
+module m14
+  interface gen1
+    module procedure s
+  end interface
+  generic :: gen2 => s
+ contains
+  subroutine s(x)
+    integer(1) :: x
+  end subroutine s
+end module m14
+module m15
+  use m14
+  interface gen1
+    module procedure gen1
+  end interface
+  generic :: gen2 => gen2
+ contains
+  subroutine gen1(x)
+    integer(2) :: x
+  end subroutine gen1
+  subroutine gen2(x)
+    integer(4) :: x
+  end subroutine gen2
+end module m15