[flang] Accept ENTRY names in generic interfaces

ENTRY statement names in module subprograms were not acceptable for
use as a "module procedure" in a generic interface, but should be.
ENTRY statements need to have symbols with place-holding
SubprogramNameDetails created for them in order to be visible in
generic interfaces.  Those symbols are created from the "program
tree" data structure.  This patch adds ENTRY statement names to the
program tree data structure and uses them to generate SubprogramNameDetails
symbols.

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

Author: klausler

flang/include/flang/Semantics/symbol.h

@@ -107,7 +107,7 @@ class SubprogramDetails : public WithBindName {
 };
 
 // For SubprogramNameDetails, the kind indicates whether it is the name
-// of a module subprogram or internal subprogram.
+// of a module subprogram or an internal subprogram or ENTRY.
 ENUM_CLASS(SubprogramKind, Module, Internal)
 
 // Symbol with SubprogramNameDetails is created when we scan for module and
@@ -121,10 +121,16 @@ class SubprogramNameDetails {
   SubprogramNameDetails() = delete;
   SubprogramKind kind() const { return kind_; }
   ProgramTree &node() const { return *node_; }
+  bool isEntryStmt() const { return isEntryStmt_; }
+  SubprogramNameDetails &set_isEntryStmt(bool yes = true) {
+    isEntryStmt_ = yes;
+    return *this;
+  }
 
 private:
   SubprogramKind kind_;
   common::Reference<ProgramTree> node_;
+  bool isEntryStmt_{false};
 };
 
 // A name from an entity-decl -- could be object or function.

flang/lib/Semantics/program-tree.cpp

@@ -13,13 +13,46 @@
 
 namespace Fortran::semantics {
 
+static void GetEntryStmts(
+    ProgramTree &node, const parser::SpecificationPart &spec) {
+  const auto &implicitPart{std::get<parser::ImplicitPart>(spec.t)};
+  for (const parser::ImplicitPartStmt &stmt : implicitPart.v) {
+    if (const auto *entryStmt{std::get_if<
+            parser::Statement<common::Indirection<parser::EntryStmt>>>(
+            &stmt.u)}) {
+      node.AddEntry(entryStmt->statement.value());
+    }
+  }
+  for (const auto &decl :
+      std::get<std::list<parser::DeclarationConstruct>>(spec.t)) {
+    if (const auto *entryStmt{std::get_if<
+            parser::Statement<common::Indirection<parser::EntryStmt>>>(
+            &decl.u)}) {
+      node.AddEntry(entryStmt->statement.value());
+    }
+  }
+}
+
+static void GetEntryStmts(
+    ProgramTree &node, const parser::ExecutionPart &exec) {
+  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());
+    }
+  }
+}
+
 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);
   if (subps) {
     for (const auto &subp :
         std::get<std::list<parser::InternalSubprogram>>(subps->t)) {
@@ -34,7 +67,7 @@ static ProgramTree BuildSubprogramTree(const parser::Name &name, const T &x) {
 static ProgramTree BuildSubprogramTree(
     const parser::Name &name, const parser::BlockData &x) {
   const auto &spec{std::get<parser::SpecificationPart>(x.t)};
-  return ProgramTree{name, spec, nullptr};
+  return ProgramTree{name, spec};
 }
 
 template <typename T>
@@ -193,4 +226,8 @@ void ProgramTree::AddChild(ProgramTree &&child) {
   children_.emplace_back(std::move(child));
 }
 
+void ProgramTree::AddEntry(const parser::EntryStmt &entryStmt) {
+  entryStmts_.emplace_back(entryStmt);
+}
+
 } // namespace Fortran::semantics

flang/lib/Semantics/program-tree.h

@@ -29,6 +29,8 @@ class Scope;
 
 class ProgramTree {
 public:
+  using EntryStmtList = std::list<common::Reference<const parser::EntryStmt>>;
+
   // Build the ProgramTree rooted at one of these program units.
   static ProgramTree Build(const parser::ProgramUnit &);
   static ProgramTree Build(const parser::MainProgram &);
@@ -69,12 +71,17 @@ class ProgramTree {
   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_;
+  }
   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 &);
 
   template <typename T>
   ProgramTree &set_stmt(const parser::Statement<T> &stmt) {
@@ -94,6 +101,7 @@ class ProgramTree {
   const parser::SpecificationPart &spec_;
   const parser::ExecutionPart *exec_{nullptr};
   std::list<ProgramTree> children_;
+  EntryStmtList entryStmts_;
   Scope *scope_{nullptr};
   const parser::CharBlock *endStmt_{nullptr};
   bool isSpecificationPartResolved_{false};

flang/lib/Semantics/resolve-names.cpp

@@ -2796,7 +2796,7 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
   }
   auto range{specificProcs_.equal_range(&generic)};
   for (auto it{range.first}; it != range.second; ++it) {
-    auto *name{it->second.first};
+    const parser::Name *name{it->second.first};
     auto kind{it->second.second};
     const auto *symbol{FindSymbol(*name)};
     if (!symbol) {
@@ -6915,13 +6915,21 @@ void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
   }
 }
 
-// Add SubprogramNameDetails symbols for module and internal subprograms
+// Add SubprogramNameDetails symbols for module and internal subprograms and
+// their ENTRY statements.
 void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
   auto kind{
       node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
   for (auto &child : node.children()) {
     auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
     symbol.set(child.GetSubpFlag());
+    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());
+    }
   }
 }
 
@@ -7125,7 +7133,8 @@ void ResolveSpecificationParts(
     SemanticsContext &context, const Symbol &subprogram) {
   auto originalLocation{context.location()};
   ResolveNamesVisitor visitor{context, DEREF(sharedImplicitRulesMap)};
-  ProgramTree &node{subprogram.get<SubprogramNameDetails>().node()};
+  const auto &details{subprogram.get<SubprogramNameDetails>()};
+  ProgramTree &node{details.node()};
   const Scope &moduleScope{subprogram.owner()};
   visitor.SetScope(const_cast<Scope &>(moduleScope));
   visitor.ResolveSpecificationParts(node);

flang/test/Semantics/entry01.f90

@@ -139,11 +139,12 @@ subroutine externals
 end subroutine
 
 module m2
+  !ERROR: EXTERNAL attribute not allowed on 'm2entry2'
   external m2entry2
  contains
   subroutine m2subr1
     entry m2entry1 ! ok
-    entry m2entry2 ! ok
+    entry m2entry2 ! NOT ok
     entry m2entry3 ! ok
   end subroutine
 end module
@@ -173,6 +174,27 @@ subroutine m3subr1
   end subroutine
 end module
 
+module m4
+  interface generic1
+    module procedure m4entry1
+  end interface
+  interface generic2
+    module procedure m4entry2
+  end interface
+  interface generic3
+    module procedure m4entry3
+  end interface
+ contains
+  subroutine m4subr1
+    entry m4entry1 ! in implicit part
+    integer :: n = 0
+    entry m4entry2 ! in specification part
+    n = 123
+    entry m4entry3 ! in executable part
+    print *, n
+  end subroutine
+end module
+
 function inone
   implicit none
   integer :: inone