[flang] Accept ENTRY names in generic interfaces

[klausler]

Summary

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.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/include/flang/Semantics/symbol.h

private:
   Symbol *result_{nullptr};
   Scope *entryScope_{nullptr}; // if ENTRY, points to subprogram's scope
   MaybeExpr stmtFunction_;
   friend llvm::raw_ostream &operator<<(
       llvm::raw_ostream &, const SubprogramDetails &);
 };
 
 // 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
 // internal procedure names, to record that there is a subprogram with this
 // name. Later they are replaced by SubprogramDetails with dummy and result
 // type information.
 class SubprogramNameDetails {
 public:
   SubprogramNameDetails(SubprogramKind kind, ProgramTree &node)
       : kind_{kind}, node_{node} {}
   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.
 class EntityDetails : public WithBindName {
 public:
   explicit EntityDetails(bool isDummy = false) : isDummy_{isDummy} {}
   const DeclTypeSpec *type() const { return type_; }
   void set_type(const DeclTypeSpec &);

flang/lib/Semantics/program-tree.h

 //   - a child node for each contained subprogram
 
 namespace Fortran::semantics {
 
 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 &);
   static ProgramTree Build(const parser::FunctionSubprogram &);
   static ProgramTree Build(const parser::SubroutineSubprogram &);
   static ProgramTree Build(const parser::SeparateModuleSubprogram &);
   static ProgramTree Build(const parser::Module &);
   static ProgramTree Build(const parser::Submodule &);
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_;
+  }
   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) {
     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_;
   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

 //===-- lib/Semantics/program-tree.cpp ------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "program-tree.h"
 #include "flang/Common/idioms.h"
 #include "flang/Parser/char-block.h"
 #include "flang/Semantics/scope.h"
 
 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)) {
       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, nullptr};
+  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};
   if (subps) {
void ProgramTree::set_scope(Scope &scope) {
   CHECK(endStmt_);
   scope.AddSourceRange(*endStmt_);
 }
 
 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/resolve-names.cpp

 void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
   auto &details{generic.get<GenericDetails>()};
   UnorderedSymbolSet symbolsSeen;
   for (const Symbol &symbol : details.specificProcs()) {
     symbolsSeen.insert(symbol.GetUltimate());
   }
   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) {
       Say(*name, "Procedure '%s' not found"_err_en_US);
       continue;
     }
     const Symbol &specific{BypassGeneric(*symbol)};
     const Symbol &ultimate{specific.GetUltimate()};
void ResolveNamesVisitor::ResolveSpecificationParts(ProgramTree &node) {
   ExecutionPartSkimmer{*this}.Walk(node.exec());
   PopScope();
   // Ensure that every object entity has a type.
   for (auto &pair : *node.scope()) {
     ApplyImplicitRules(*pair.second);
   }
 }
 
-// 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());
+    }
   }
 }
 
 // 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:

 }
 
 // Processes a module (but not internal) function when it is referenced
 // in a specification expression in a sibling procedure.
 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);
   context.set_location(std::move(originalLocation));
 }
 
 } // namespace Fortran::semantics

flang/test/Semantics/entry01.f90

subroutine externals
   entry iok1
   integer :: ix
   ix = iproc()
   !ERROR: 'iproc' was previously called as a function
   entry iproc
 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
 
 subroutine usem2
   use m2
   interface
     subroutine simplesubr
module m3
   end interface
  contains
   subroutine m3subr1
     !ERROR: 'm3entry1' is already declared in this scoping unit
     entry m3entry1
   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
   !ERROR: No explicit type declared for 'implicitbad1'
   entry implicitbad1
   inone = 0 ! force transition to execution part
   !ERROR: No explicit type declared for 'implicitbad2'
   entry implicitbad2
 end