[flang] Allow more forward references to ENTRY names

[klausler]

Summary

Forward references to ENTRY names to pass them as actual procedure arguments
don't work in all cases, exposing some basic ordering problems in
name resolution for these symbols. Refactor; create all the
necessary procedure symbols, and either function result or host association
symbols (for subroutines), at the time that the subprogrma scope is
created, so that the names exist in the scope as text "before"
the ENTRY is processed in name resolution. Some processing
remains in PostEntryStmt() so that we can check that an ENTRY with
an explicit distinct RESULT doesn't also have declarations for the
ENTRY name.

flang/include/flang/Semantics/symbol.h

 // 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/Evaluate/tools.cpp

 bool IsPureProcedure(const Scope &scope) {
   const Symbol *symbol{scope.GetSymbol()};
   return symbol && IsPureProcedure(*symbol);
 }
 
 bool IsFunction(const Symbol &symbol) {
   const Symbol &ultimate{symbol.GetUltimate()};
   return ultimate.test(Symbol::Flag::Function) ||
+      (!ultimate.test(Symbol::Flag::Subroutine) &&
           common::visit(
               common::visitors{
                   [](const SubprogramDetails &x) { return x.isFunction(); },
                   [](const ProcEntityDetails &x) {
                     const auto &ifc{x.interface()};
                     return ifc.type() ||
                         (ifc.symbol() && IsFunction(*ifc.symbol()));
                   },
                   [](const ProcBindingDetails &x) {
                     return IsFunction(x.symbol());
                   },
                   [](const auto &) { return false; },
               },
-          ultimate.details());
+              ultimate.details()));
 }
 
 bool IsFunction(const Scope &scope) {
   const Symbol *symbol{scope.GetSymbol()};
   return symbol && IsFunction(*symbol);
 }
 
 bool IsProcedure(const Symbol &symbol) {
bool IsDeferredShape(const Symbol &symbol) {
   const Symbol &ultimate{ResolveAssociations(symbol)};
   const auto *object{ultimate.detailsIf<ObjectEntityDetails>()};
   return object && object->CanBeDeferredShape() &&
       evaluate::IsAllocatableOrPointer(ultimate);
 }
 
 bool IsFunctionResult(const Symbol &original) {
   const Symbol &symbol{GetAssociationRoot(original)};
-  return (symbol.has<ObjectEntityDetails>() &&
-             symbol.get<ObjectEntityDetails>().isFuncResult()) ||
-      (symbol.has<ProcEntityDetails>() &&
-          symbol.get<ProcEntityDetails>().isFuncResult());
+  return common::visit(
+      common::visitors{
+          [](const EntityDetails &x) { return x.isFuncResult(); },
+          [](const ObjectEntityDetails &x) { return x.isFuncResult(); },
+          [](const ProcEntityDetails &x) { return x.isFuncResult(); },
+          [](const auto &) { return false; },
+      },
+      symbol.details());
 }
 
 bool IsKindTypeParameter(const Symbol &symbol) {
   const auto *param{symbol.GetUltimate().detailsIf<TypeParamDetails>()};
   return param && param->attr() == common::TypeParamAttr::Kind;
 }
 
 bool IsLenTypeParameter(const Symbol &symbol) {

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::CheckSubprogram(
   if (const Scope * entryScope{details.entryScope()}) {
     // ENTRY 15.6.2.6, esp. C1571
     std::optional<parser::MessageFixedText> error;
     const Symbol *subprogram{entryScope->symbol()};
     const SubprogramDetails *subprogramDetails{nullptr};
     if (subprogram) {
       subprogramDetails = subprogram->detailsIf<SubprogramDetails>();
     }
-    if (entryScope->kind() != Scope::Kind::Subprogram) {
-      error = "ENTRY may appear only in a subroutine or function"_err_en_US;
-    } else if (!(entryScope->parent().IsGlobal() ||
-                   entryScope->parent().IsModule() ||
-                   entryScope->parent().IsSubmodule())) {
+    if (!(entryScope->parent().IsGlobal() || entryScope->parent().IsModule() ||
       error = "ENTRY may not appear in an internal subprogram"_err_en_US;
-    } else if (FindSeparateModuleSubprogramInterface(subprogram)) {
-      error = "ENTRY may not appear in a separate module procedure"_err_en_US;
     } else if (subprogramDetails && details.isFunction() &&
         subprogramDetails->isFunction() &&
         !context_.HasError(details.result()) &&
         !context_.HasError(subprogramDetails->result())) {
       auto result{FunctionResult::Characterize(
           details.result(), context_.foldingContext())};
       auto subpResult{FunctionResult::Characterize(
           subprogramDetails->result(), context_.foldingContext())};

 
 // Check distinguishability of generic assignment and operators.
 // For these, generics and generic bindings must be considered together.
 void CheckHelper::CheckGenericOps(const Scope &scope) {
   DistinguishabilityHelper helper{context_};
   auto addSpecifics{[&](const Symbol &generic) {
     const auto *details{generic.GetUltimate().detailsIf<GenericDetails>()};
     if (!details) {
-      if (generic.test(Symbol::Flag::Function)) {
+      // Not a generic; ensure characteristics are defined if a function.
+      auto restorer{messages_.SetLocation(generic.name())};
+      if (IsFunction(generic) && !context_.HasError(generic)) {
+        if (const Symbol * result{FindFunctionResult(generic)};
+            result && !context_.HasError(*result)) {
           Characterize(generic);
         }
+      }
       return;
     }
     GenericKind kind{details->kind()};
     if (!kind.IsAssignment() && !kind.IsOperator()) {
       return;
     }
     const SymbolVector &specifics{details->specificProcs()};
     const std::vector<SourceName> &bindingNames{details->bindingNames()};
     for (std::size_t i{0}; i < specifics.size(); ++i) {
       const Symbol &specific{*specifics[i]};
-      if (const Procedure * proc{Characterize(specific)}) {
-        auto restorer{messages_.SetLocation(bindingNames[i])};
+      if (const Procedure * proc{Characterize(specific)}) {
         if (kind.IsAssignment()) {
           if (!CheckDefinedAssignment(specific, *proc)) {
             continue;
           }
         } else {
           if (!CheckDefinedOperator(generic.name(), kind, specific, *proc)) {
             continue;
           }

flang/lib/Semantics/resolve-names.cpp

 // in the type specification to resolve to local names.
 class FuncResultStack {
 public:
   explicit FuncResultStack(ScopeHandler &scopeHandler)
       : scopeHandler_{scopeHandler} {}
   ~FuncResultStack();
 
   struct FuncInfo {
+    explicit FuncInfo(const Scope &s) : scope{s} {}
+    const Scope &scope;
     // Parse tree of the type specification in the FUNCTION prefix
     const parser::DeclarationTypeSpec *parsedType{nullptr};
     // Name of the function RESULT in the FUNCTION suffix, if any
     const parser::Name *resultName{nullptr};
     // Result symbol
     Symbol *resultSymbol{nullptr};
     std::optional<SourceName> source;
     bool inFunctionStmt{false}; // true between Pre/Post of FunctionStmt
   };
 
   // Completes the definition of the top function's result.
   void CompleteFunctionResultType();
   // Completes the definition of a symbol if it is the top function's result.
   void CompleteTypeIfFunctionResult(Symbol &);
 
   FuncInfo *Top() { return stack_.empty() ? nullptr : &stack_.back(); }
-  FuncInfo &Push() { return stack_.emplace_back(); }
-  void Pop() { stack_.pop_back(); }
+  FuncInfo &Push(const Scope &scope) { return stack_.emplace_back(scope); }
+  void Pop();
 
 private:
   ScopeHandler &scopeHandler_;
   std::vector<FuncInfo> stack_;
 };
 
 // Manage a stack of Scopes
 class ScopeHandler : public ImplicitRulesVisitor {
private:
   // so that it can be replaced by a later definition.
   bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
   void CheckExtantProc(const parser::Name &, Symbol::Flag);
   // Create a subprogram symbol in the current scope and push a new scope.
   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
       const parser::LanguageBindingSpec * = nullptr);
   Symbol *GetSpecificFromGeneric(const parser::Name &);
   SubprogramDetails &PostSubprogramStmt(const parser::Name &);
+  void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);
   void PostEntryStmt(const parser::EntryStmt &stmt);
 };
 
 class DeclarationVisitor : public ArraySpecVisitor,
                            public virtual ScopeHandler {
 public:
   using ArraySpecVisitor::Post;
   using ScopeHandler::Post;

 }
 
 // FuncResultStack implementation
 
 FuncResultStack::~FuncResultStack() { CHECK(stack_.empty()); }
 
 void FuncResultStack::CompleteFunctionResultType() {
   // If the function has a type in the prefix, process it now.
-  if (IsFunction(scopeHandler_.currScope())) {
-    FuncInfo &info{DEREF(Top())};
-    if (info.parsedType) {
-      scopeHandler_.messageHandler().set_currStmtSource(info.source);
+  FuncInfo *info{Top()};
+  if (info && &info->scope == &scopeHandler_.currScope()) {
+    if (info->parsedType) {
+      scopeHandler_.messageHandler().set_currStmtSource(info->source);
       if (const auto *type{
-              scopeHandler_.ProcessTypeSpec(*info.parsedType, true)}) {
-        if (!scopeHandler_.context().HasError(info.resultSymbol)) {
-          info.resultSymbol->SetType(*type);
+              scopeHandler_.ProcessTypeSpec(*info->parsedType, true)}) {
+        if (!scopeHandler_.context().HasError(info->resultSymbol)) {
+          info->resultSymbol->SetType(*type);
         }
       }
-      info.parsedType = nullptr;
+      info->parsedType = nullptr;
     }
   }
 }
 
 // Called from ConvertTo{Object/Proc}Entity to cope with any appearance
 // of the function result in a specification expression.
 void FuncResultStack::CompleteTypeIfFunctionResult(Symbol &symbol) {
   if (FuncInfo * info{Top()}) {
     if (info->resultSymbol == &symbol) {
       CompleteFunctionResultType();
     }
   }
 }
 
+void FuncResultStack::Pop() {
+  if (!stack_.empty() && &stack_.back().scope == &scopeHandler_.currScope()) {
+    stack_.pop_back();
+  }
+}
+
 // ScopeHandler implementation
 
 void ScopeHandler::SayAlreadyDeclared(const parser::Name &name, Symbol &prev) {
   SayAlreadyDeclared(name.source, prev);
 }
 void ScopeHandler::SayAlreadyDeclared(const SourceName &name, Symbol &prev) {
   if (context().HasError(prev)) {
     // don't report another error about prev

 }
 void ScopeHandler::PopScope() {
   // Entities that are not yet classified as objects or procedures are now
   // assumed to be objects.
   // TODO: Statement functions
   for (auto &pair : currScope()) {
     ConvertToObjectEntity(*pair.second);
   }
+  funcResultStack_.Pop();
   // If popping back into a global scope, pop back to the main global scope.
   SetScope(currScope_->parent().IsGlobal() ? context().globalScope()
                                            : currScope_->parent());
 }
 void ScopeHandler::SetScope(Scope &scope) {
   currScope_ = &scope;
   ImplicitRulesVisitor::SetScope(InclusiveScope());
 }

 }
 // Convert symbol to be a ProcEntity or return false if it can't be.
 bool ScopeHandler::ConvertToProcEntity(Symbol &symbol) {
   if (symbol.has<ProcEntityDetails>()) {
     // nothing to do
   } else if (symbol.has<UnknownDetails>()) {
     symbol.set_details(ProcEntityDetails{});
   } else if (auto *details{symbol.detailsIf<EntityDetails>()}) {
+    if (IsFunctionResult(symbol) &&
+        !(IsPointer(symbol) && symbol.attrs().test(Attr::EXTERNAL))) {
+      // Don't turn function result into a procedure pointer unless both
+      // POUNTER and EXTERNAL
+      return false;
+    }
     funcResultStack_.CompleteTypeIfFunctionResult(symbol);
     symbol.set_details(ProcEntityDetails{std::move(*details)});
     if (symbol.GetType() && !symbol.test(Symbol::Flag::Implicit)) {
       CHECK(!symbol.test(Symbol::Flag::Subroutine));
       symbol.set(Symbol::Flag::Function);
     }
   } else if (auto *useDetails{symbol.detailsIf<UseDetails>()}) {
     return useDetails->symbol().has<ProcEntityDetails>();
void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
     Symbol &dummy{MakeSymbol(dummyName, EntityDetails{true})};
     details.add_dummyArg(dummy);
   }
   const parser::Name *funcResultName;
   FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
   CHECK(info.inFunctionStmt);
   info.inFunctionStmt = false;
-  if (info.resultName && info.resultName->source != name.source) {
+  bool distinctResultName{
+      info.resultName && info.resultName->source != name.source};
+  if (distinctResultName) {
     // Note that RESULT is ignored if it has the same name as the function.
+    // The symbol created by PushScope() is retained as a place-holder
+    // for error detection.
     funcResultName = info.resultName;
   } else {
-    EraseSymbol(name); // was added by PushSubprogramScope
+    EraseSymbol(name); // was added by PushScope()
     funcResultName = &name;
   }
-  // add function result to function scope
   if (details.isFunction()) {
     CHECK(context().HasError(currScope().symbol()));
   } else {
+    // RESULT(x) can be the same explicitly-named RESULT(x) as an ENTRY
+    // statement.
+    Symbol *result{nullptr};
+    if (distinctResultName) {
+      if (auto iter{currScope().find(funcResultName->source)};
+          iter != currScope().end()) {
+        Symbol &entryResult{*iter->second};
+        if (IsFunctionResult(entryResult)) {
+          result = &entryResult;
+        }
+      }
+    }
+    if (result) {
+      Resolve(*funcResultName, *result);
+    } else {
       // add function result to function scope
       EntityDetails funcResultDetails;
       funcResultDetails.set_funcResult(true);
-    Symbol &result{MakeSymbol(*funcResultName, std::move(funcResultDetails))};
-    info.resultSymbol = &result;
-    details.set_result(result);
+      result = &MakeSymbol(*funcResultName, std::move(funcResultDetails));
+    }
+    info.resultSymbol = result;
+    details.set_result(*result);
   }
   // C1560.
-  if (info.resultName && info.resultName->source == name.source) {
+  if (info.resultName && !distinctResultName) {
     Say(info.resultName->source,
         "The function name should not appear in RESULT, references to '%s' "
         "inside the function will be considered as references to the "
         "result only"_warn_en_US,
         name.source);
     // RESULT name was ignored above, the only side effect from doing so will be
     // the inability to make recursive calls. The related parser::Name is still
     // resolved to the created function result symbol because every parser::Name
SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
   return symbol.get<SubprogramDetails>();
 }
 
 void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
   PostEntryStmt(stmt);
   EndAttrs();
 }
 
-void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
-  Scope &inclusiveScope{InclusiveScope()};
-  const Symbol *subprogram{inclusiveScope.symbol()};
-  if (!subprogram) {
-    CHECK(context().AnyFatalError());
+void SubprogramVisitor::CreateEntry(
+    const parser::EntryStmt &stmt, Symbol &subprogram) {
+  const auto &entryName{std::get<parser::Name>(stmt.t)};
+  Scope &outer{currScope().parent()};
+  Symbol::Flag subpFlag{subprogram.test(Symbol::Flag::Function)
+          ? Symbol::Flag::Function
+          : Symbol::Flag::Subroutine};
+  Attrs attrs;
+  if (Symbol * extant{FindSymbol(outer, entryName)}) {
+    if (!HandlePreviousCalls(entryName, *extant, subpFlag)) {
+      if (outer.IsTopLevel()) {
+        Say2(entryName,
+            "'%s' is already defined as a global identifier"_err_en_US, *extant,
+            "Previous definition of '%s'"_en_US);
+      } else {
+        SayAlreadyDeclared(entryName, *extant);
+      }
       return;
     }
-  const auto &name{std::get<parser::Name>(stmt.t)};
-  const parser::Name *resultName{nullptr};
-  if (const auto &maybeSuffix{
-          std::get<std::optional<parser::Suffix>>(stmt.t)}) {
-    resultName = common::GetPtrFromOptional(maybeSuffix->resultName);
-  }
-  bool inFunction{IsFunction(currScope())};
-  if (resultName) { // RESULT(result) is present
-    if (!inFunction) {
-      // error was already emitted for the suffix
-    } else if (resultName->source == subprogram->name()) { // C1574
-      Say2(resultName->source,
+    attrs = extant->attrs();
+  }
+  const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)};
+  bool badResultName{false};
+  std::optional<SourceName> distinctResultName;
+  if (suffix && suffix->resultName &&
+      suffix->resultName->source != entryName.source) {
+    distinctResultName = suffix->resultName->source;
+    const parser::Name &resultName{*suffix->resultName};
+    if (resultName.source == subprogram.name()) { // C1574
+      Say2(resultName.source,
           "RESULT(%s) may not have the same name as the function"_err_en_US,
-          subprogram->name(), "Containing function"_en_US);
-    } else if (const Symbol *
-        symbol{FindSymbol(inclusiveScope.parent(), *resultName)}) { // C1574
-      if (const auto *details{symbol->detailsIf<SubprogramDetails>()}) {
-        if (details->entryScope() == &inclusiveScope) {
-          Say2(resultName->source,
+          subprogram, "Containing function"_en_US);
+      badResultName = true;
+    } else if (const Symbol * extant{FindSymbol(outer, resultName)}) { // C1574
+      if (const auto *details{extant->detailsIf<SubprogramDetails>()}) {
+        if (details->entryScope() == &currScope()) {
+          Say2(resultName.source,
               "RESULT(%s) may not have the same name as an ENTRY in the function"_err_en_US,
-              symbol->name(), "Conflicting ENTRY"_en_US);
+              extant->name(), "Conflicting ENTRY"_en_US);
+          badResultName = true;
         }
       }
     }
-    if (Symbol * symbol{FindSymbol(name)}) { // C1570
-      // When RESULT() appears, ENTRY name can't have been already declared
-      if (inclusiveScope.Contains(symbol->owner())) {
-        Say2(name,
-            "ENTRY name '%s' may not be declared when RESULT() is present"_err_en_US,
-            *symbol, "Previous declaration of '%s'"_en_US);
-      }
-    }
-    if (resultName->source == name.source) {
-      // ignore RESULT() hereafter when it's the same name as the ENTRY
-      resultName = nullptr;
+  if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
+    attrs.set(Attr::PUBLIC);
+  Symbol &entrySymbol{MakeSymbol(outer, entryName.source, attrs)};
+  SubprogramDetails entryDetails;
+  entryDetails.set_entryScope(currScope());
+  entrySymbol.set(subpFlag);
+  if (subpFlag == Symbol::Flag::Function) {
+    Symbol *result{nullptr};
+    EntityDetails resultDetails;
+    resultDetails.set_funcResult(true);
+    if (distinctResultName) {
+      if (!badResultName) {
+        // RESULT(x) can be the same explicitly-named RESULT(x) as
+        // the enclosing function or another ENTRY.
+        if (auto iter{currScope().find(suffix->resultName->source)};
+            iter != currScope().end()) {
+          result = &*iter->second;
         }
+        if (!result) {
+          result = &MakeSymbol(
+              *distinctResultName, Attrs{}, std::move(resultDetails));
+        }
+        Resolve(*suffix->resultName, *result);
       }
-  SubprogramDetails entryDetails;
-  entryDetails.set_entryScope(inclusiveScope);
-  if (inFunction) {
-    // Create the entity to hold the function result, if necessary.
-    auto &effectiveResultName{*(resultName ? resultName : &name)};
-    Symbol *resultSymbol{FindInScope(currScope(), effectiveResultName)};
-    if (resultSymbol) { // C1574
-      common::visit(
-          common::visitors{[resultSymbol](UnknownDetails &) {
-                             EntityDetails entity;
-                             entity.set_funcResult(true);
-                             resultSymbol->set_details(std::move(entity));
-                           },
-              [](EntityDetails &x) { x.set_funcResult(true); },
-              [](ObjectEntityDetails &x) { x.set_funcResult(true); },
-              [](ProcEntityDetails &x) { x.set_funcResult(true); },
-              [&](const auto &) {
-                Say2(effectiveResultName.source,
-                    "'%s' was previously declared as an item that may not be used as a function result"_err_en_US,
-                    resultSymbol->name(), "Previous declaration of '%s'"_en_US);
-                context().SetError(*resultSymbol);
-              }},
-          resultSymbol->details());
-      // The Function flag will have been set if the ENTRY's symbol was created
-      // as a placeholder in BeginSubprogram.  This prevents misuse of the ENTRY
-      // as a subroutine.  Clear it now because it's inappropriate for a
-      // function result.
-      resultSymbol->set(Symbol::Flag::Function, false);
-    } else if (!inSpecificationPart_) {
-      ObjectEntityDetails entity;
-      entity.set_funcResult(true);
-      resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
-      ApplyImplicitRules(*resultSymbol);
     } else {
-      EntityDetails entity;
-      entity.set_funcResult(true);
-      resultSymbol = &MakeSymbol(effectiveResultName, std::move(entity));
-    }
-    if (!resultName) {
-      name.symbol = nullptr; // symbol will be used for entry point below
-    }
-    entryDetails.set_result(*resultSymbol);
-  }
+      result = &MakeSymbol(entryName.source, Attrs{}, std::move(resultDetails));
+    }
+    if (result) {
+      entryDetails.set_result(*result);
+    }
+  if (subpFlag == Symbol::Flag::Subroutine ||
+      (distinctResultName && !badResultName)) {
+    Symbol &assoc{MakeSymbol(entryName.source)};
+    assoc.set_details(HostAssocDetails{entrySymbol});
+    assoc.set(Symbol::Flag::Subroutine);
+  Resolve(entryName, entrySymbol);
+  entrySymbol.set_details(std::move(entryDetails));
 
+void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
+  // The entry symbol should have already been created and resolved
+  // in CreateEntry(), called by BeginSubprogram(), with one exception (below).
+  const auto &name{std::get<parser::Name>(stmt.t)};
+  Scope &inclusiveScope{InclusiveScope()};
+  if (!name.symbol) {
+    if (inclusiveScope.kind() != Scope::Kind::Subprogram) {
+      Say(name.source,
+          "ENTRY '%s' may appear only in a subroutine or function"_err_en_US,
+          name.source);
+    } else if (FindSeparateModuleSubprogramInterface(inclusiveScope.symbol())) {
+      Say(name.source,
+          "ENTRY '%s' may not appear in a separate module procedure"_err_en_US,
+          name.source);
+    } else {
+      // C1571 - entry is nested, so was not put into the program tree; error
+      // is emitted from MiscChecker in semantics.cpp.
+    }
+    return;
+  }
+  Symbol &entrySymbol{*name.symbol};
+  if (context().HasError(entrySymbol)) {
+    return;
+  }
+  if (!entrySymbol.has<SubprogramDetails>()) {
+    SayAlreadyDeclared(name, entrySymbol);
+    return;
+  }
+  SubprogramDetails &entryDetails{entrySymbol.get<SubprogramDetails>()};
+  CHECK(entryDetails.entryScope() == &inclusiveScope);
+  entrySymbol.attrs() |= GetAttrs();
+  SetBindNameOn(entrySymbol);
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
       Symbol *dummy{FindSymbol(*dummyName)};
       if (dummy) {
         common::visit(
             common::visitors{[](EntityDetails &x) { x.set_isDummy(); },
                 [](ObjectEntityDetails &x) { x.set_isDummy(); },
                 [](ProcEntityDetails &x) { x.set_isDummy(); },
                 [](SubprogramDetails &x) { x.set_isDummy(); },
                 [&](const auto &) {
                   Say2(dummyName->source,
                       "ENTRY dummy argument '%s' is previously declared as an item that may not be used as a dummy argument"_err_en_US,
                       dummy->name(), "Previous declaration of '%s'"_en_US);
                 }},
             dummy->details());
       } else {
         dummy = &MakeSymbol(*dummyName, EntityDetails{true});
         if (!inSpecificationPart_) {
           ApplyImplicitRules(*dummy);
         }
       }
       entryDetails.add_dummyArg(*dummy);
     } else {
-      if (inFunction) { // C1573
+      if (entrySymbol.test(Symbol::Flag::Function)) { // C1573
         Say(name,
             "ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
         break;
       }
       entryDetails.add_alternateReturn();
     }
   }
-
-  Symbol::Flag subpFlag{
-      inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
-  Scope &outer{inclusiveScope.parent()}; // global or module scope
-  if (outer.IsModule() && attrs_ && !attrs_->test(Attr::PRIVATE)) {
-    attrs_->set(Attr::PUBLIC);
-  }
-  if (Symbol * extant{FindSymbol(outer, name)}) {
-    if (!HandlePreviousCalls(name, *extant, subpFlag)) {
-      if (outer.IsGlobal()) {
-        Say2(name, "'%s' is already defined as a global identifier"_err_en_US,
-            *extant, "Previous definition of '%s'"_en_US);
-      } else {
-        SayAlreadyDeclared(name, *extant);
-      }
-      return;
-    }
-  }
-
-  Symbol *entrySymbol{&MakeSymbol(outer, name.source, GetAttrs())};
-  if (auto *generic{entrySymbol->detailsIf<GenericDetails>()}) {
-    CHECK(generic->specific());
-    entrySymbol = generic->specific();
-  }
-  entrySymbol->set_details(std::move(entryDetails));
-  SetBindNameOn(*entrySymbol);
-  entrySymbol->set(subpFlag);
-  Resolve(name, *entrySymbol);
 }
 
 // A subprogram declared with MODULE PROCEDURE
 bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
   auto *symbol{FindSymbol(name)};
   if (symbol && symbol->has<SubprogramNameDetails>()) {
     symbol = FindSymbol(currScope().parent(), name);
   }
   if (!IsSeparateModuleProcedureInterface(symbol)) {
     Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
     return false;
   }
   if (symbol->owner() == currScope() && symbol->scope()) {
     // This is a MODULE PROCEDURE whose interface appears in its host.
     // Convert the module procedure's interface into a subprogram.
     SetScope(DEREF(symbol->scope()));
     symbol->get<SubprogramDetails>().set_isInterface(false);
-    if (IsFunction(*symbol)) {
-      funcResultStack().Push(); // just to be popped later
-    }
   } else {
     // Copy the interface into a new subprogram scope.
     Symbol &newSymbol{MakeSymbol(name, SubprogramDetails{})};
     PushScope(Scope::Kind::Subprogram, &newSymbol);
     const auto &details{symbol->get<SubprogramDetails>()};
     auto &newDetails{newSymbol.get<SubprogramDetails>()};
     newDetails.set_moduleInterface(*symbol);
     for (const Symbol *dummyArg : details.dummyArgs()) {
       if (!dummyArg) {
         newDetails.add_alternateReturn();
       } else if (Symbol * copy{currScope().CopySymbol(*dummyArg)}) {
         newDetails.add_dummyArg(*copy);
       }
     }
     if (details.isFunction()) {
       currScope().erase(symbol->name());
       newDetails.set_result(*currScope().CopySymbol(details.result()));
-      funcResultStack().Push(); // just to be popped later
     }
   }
   return true;
 }
 
 // A subprogram or interface declared with SUBROUTINE or FUNCTION
 bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
     Symbol::Flag subpFlag, bool hasModulePrefix,
bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
   if (moduleInterface) {
     newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
     if (moduleInterface->attrs().test(Attr::PRIVATE)) {
       newSymbol.attrs().set(Attr::PRIVATE);
     } else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
       newSymbol.attrs().set(Attr::PUBLIC);
     }
   }
-  if (IsFunction(currScope())) {
-    funcResultStack().Push();
-    if (entryStmts) {
-      // It's possible to refer to the function result variable of an ENTRY
-      // statement that lacks an explicit RESULT in code that appears before the
-      // ENTRY. Create a placeholder symbol now for that case so that the name
-      // doesn't resolve instead to the ENTRY's symbol in the scope around the
-      // function.
-      for (const auto &ref : *entryStmts) {
-        const auto &suffix{std::get<std::optional<parser::Suffix>>(ref->t)};
-        if (!(suffix && suffix->resultName)) {
-          Symbol &symbol{MakeSymbol(std::get<parser::Name>(ref->t).source,
-              Attrs{}, UnknownDetails{})};
-          symbol.set(Symbol::Flag::Function);
-        }
-      }
+      CreateEntry(*ref, newSymbol);
     }
   }
   return true;
 }
 
-void SubprogramVisitor::EndSubprogram() {
-  if (IsFunction(currScope())) {
-    funcResultStack().Pop();
-  }
-  PopScope();
-}
+void SubprogramVisitor::EndSubprogram() { PopScope(); }
 
 bool SubprogramVisitor::HandlePreviousCalls(
     const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
   // If the extant symbol is a generic, check its homonymous specific
   // procedure instead if it has one.
   if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
     return generic->specific() &&
         HandlePreviousCalls(name, *generic->specific(), subpFlag);
if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
               MiscDetails{MiscDetails::Kind::ScopeName}));
     }
     CheckExtantProc(name, subpFlag);
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
   symbol->ReplaceName(name.source);
   symbol->set(subpFlag);
   PushScope(Scope::Kind::Subprogram, symbol);
+  if (subpFlag == Symbol::Flag::Function) {
+    funcResultStack().Push(currScope());
+  }
   if (inInterfaceBlock()) {
     auto &details{symbol->get<SubprogramDetails>()};
     details.set_isInterface();
     if (isAbstract()) {
       symbol->attrs().set(Attr::ABSTRACT);
     } else {
       MakeExternal(*symbol);
     }
if (!symbol->attrs().test(Attr::INTRINSIC)) {
         MakeExternal(*symbol);
       }
     }
     ConvertToProcEntity(*symbol);
     SetProcFlag(name, *symbol, flag);
   } else if (CheckUseError(name)) {
     // error was reported
   } else {
-    auto &nonUltimateSymbol = *symbol;
+    auto &nonUltimateSymbol{*symbol};
     symbol = &Resolve(name, symbol)->GetUltimate();
     bool convertedToProcEntity{ConvertToProcEntity(*symbol)};
     if (convertedToProcEntity && !symbol->attrs().test(Attr::EXTERNAL) &&
         IsIntrinsic(symbol->name(), flag) && !IsDummy(*symbol)) {
       AcquireIntrinsicProcedureFlags(*symbol);
     }
     if (!SetProcFlag(name, *symbol, flag)) {
       return; // reported error
auto kind{
       node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
   for (auto &child : node.children()) {
     auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
     auto childKind{child.GetKind()};
     if (childKind == ProgramTree::Kind::Function) {
       symbol.set(Symbol::Flag::Function);
     } else if (childKind == ProgramTree::Kind::Subroutine) {
       symbol.set(Symbol::Flag::Subroutine);
+    } else {
+      continue; // make ENTRY symbols only where valid
     }
     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()) {

flang/lib/Semantics/tools.cpp

 
 const Symbol *IsFunctionResultWithSameNameAsFunction(const Symbol &symbol) {
   if (IsFunctionResult(symbol)) {
     if (const Symbol * function{symbol.owner().symbol()}) {
       if (symbol.name() == function->name()) {
         return function;
       }
     }
+    // Check ENTRY result symbols too
+    const Scope &outer{symbol.owner().parent()};
+    auto iter{outer.find(symbol.name())};
+    if (iter != outer.end()) {
+      const Symbol &outerSym{*iter->second};
+      if (const auto *subp{outerSym.detailsIf<SubprogramDetails>()}) {
+        if (subp->entryScope() == &symbol.owner() &&
+            symbol.name() == outerSym.name()) {
+          return &outerSym;
+        }
+      }
+    }
   }
   return nullptr;
 }
 
 void LabelEnforce::Post(const parser::GotoStmt &gotoStmt) {
   checkLabelUse(gotoStmt.v);
 }
 void LabelEnforce::Post(const parser::ComputedGotoStmt &computedGotoStmt) {

flang/test/Semantics/entry01.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! Tests valid and invalid ENTRY statements
 
 module m1
-  !ERROR: ENTRY may appear only in a subroutine or function
+  !ERROR: ENTRY 'badentryinmodule' may appear only in a subroutine or function
   entry badentryinmodule
   interface
     module subroutine separate
     end subroutine
   end interface
  contains
   subroutine modproc
     entry entryinmodproc ! ok
subroutine internal
       entry badentryininternal ! C1571
     end subroutine
   end subroutine
 end module
 
 submodule(m1) m1s1
  contains
   module procedure separate
-    !ERROR: ENTRY may not appear in a separate module procedure
+    !ERROR: ENTRY 'badentryinsmp' may not appear in a separate module procedure
     entry badentryinsmp ! 1571
   end procedure
 end submodule
 
 program main
-  !ERROR: ENTRY may appear only in a subroutine or function
+  !ERROR: ENTRY 'badentryinprogram' may appear only in a subroutine or function
   entry badentryinprogram ! C1571
 end program
 
 block data bd1
-  !ERROR: ENTRY may appear only in a subroutine or function
+  !ERROR: ENTRY 'badentryinbd' may appear only in a subroutine or function
   entry badentryinbd ! C1571
 end block data
 
 subroutine subr(goodarg1)
   real, intent(in) :: goodarg1
   real :: goodarg2
   !ERROR: A dummy argument may not also be a named constant
   integer, parameter :: badarg1 = 1
function ifunc()
   complex :: weird3
   logical :: weird4
   character :: weird5
   type(ibad2) :: weird6
   integer :: iarr(1)
   integer, allocatable :: alloc
   integer, pointer :: ptr
   entry iok1()
-  !ERROR: ENTRY name 'ibad1' may not be declared when RESULT() is present
+  !ERROR: 'ibad1' is already declared in this scoping unit
   entry ibad1() result(ibad1res) ! C1570
-  !ERROR: 'ibad2' was previously declared as an item that may not be used as a function result
+  !ERROR: 'ibad2' is already declared in this scoping unit
   entry ibad2()
   !ERROR: ENTRY in a function may not have an alternate return dummy argument
   entry ibadalt(*) ! C1573
   !ERROR: RESULT(ifunc) may not have the same name as the function
   entry isameres() result(ifunc) ! C1574
   entry iok()
   !ERROR: RESULT(iok) may not have the same name as an ENTRY in the function
   entry isameres2() result(iok) ! C1574
   entry isameres3() result(iok2) ! C1574
+  !ERROR: 'iok2' is already declared in this scoping unit
   entry iok2()
   !These cases are all acceptably incompatible
   entry iok3() result(weird1)
   entry iok4() result(weird2)
   entry iok5() result(weird3)
   entry iok6() result(weird4)
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry ibadt1() result(weird5)
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry ibadt2() result(weird6)
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry ibadt3() result(iarr)
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry ibadt4() result(alloc)
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry ibadt5() result(ptr)
   !ERROR: Cannot call function 'isubr' like a subroutine
   call isubr
   entry isubr()
   continue ! force transition to execution part
   entry implicit()
   implicit = 666 ! ok, just ensure that it works
+  !ERROR: Cannot call function 'implicit' like a subroutine
+  call implicit
 end function
 
 function chfunc() result(chr)
   character(len=1) :: chr
   character(len=2) :: chr1
   !ERROR: Result of ENTRY is not compatible with result of containing function
   entry chfunc1() result(chr1)
 end function
 
 subroutine externals
   !ERROR: 'subr' is already defined as a global identifier
   entry subr
   !ERROR: 'ifunc' is already defined as a global identifier
   entry ifunc
   !ERROR: 'm1' is already defined as a global identifier
   entry m1
   !ERROR: 'iok1' is already defined as a global identifier
   entry iok1
   integer :: ix
+  !ERROR: Cannot call subroutine 'iproc' like a function
+  !ERROR: Function result characteristics are not known
   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

 
 module m5
  contains
   real function setBefore
     ent = 1.0
     entry ent
   end function
 end module
+
+module m6
+ contains
+  recursive subroutine passSubr
+    call foo(passSubr)
+    call foo(ent1)
+    entry ent1
+    call foo(ent1)
+  end subroutine
+  recursive function passFunc1
+    !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+    call foo(passFunc1)
+    !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+    call foo(ent2)
+    entry ent2
+    !ERROR: Actual argument associated with procedure dummy argument 'e=' is not a procedure
+    call foo(ent2)
+  end function
+  recursive function passFunc2() result(res)
+    call foo(passFunc2)
+    call foo(ent3)
+    entry ent3() result(res)
+    call foo(ent3)
+  end function
+  subroutine foo(e)
+    external e
+  end subroutine
+end module

flang/test/Semantics/symbol20.f90

+! RUN: %python %S/test_symbols.py %s %flang_fc1
+! Test handling of pernicious case in which it is conformant Fortran
+! to use the name of a function in a CALL statement.  Almost all
+! other compilers produce bogus errors for this case and/or crash.
+
+!DEF: /m Module
+module m
+contains
+ !DEF: /m/foo PUBLIC (Function) Subprogram
+ function foo()
+  !DEF: /m/bar PUBLIC (Subroutine) Subprogram
+  !DEF: /m/foo/foo EXTERNAL, POINTER (Subroutine) ProcEntity
+  procedure(bar), pointer :: foo
+  !REF: /m/bar
+  !DEF: /m/foo/baz EXTERNAL, POINTER (Subroutine) ProcEntity
+  procedure(bar), pointer :: baz
+  !REF: /m/foo/foo
+  !REF: /m/bar
+  foo => bar
+  !REF: /m/foo/foo
+  call foo
+  !DEF: /m/baz PUBLIC (Function) Subprogram
+  entry baz()
+  !REF: /m/foo/baz
+  !REF: /m/bar
+  baz => bar
+  !REF: /m/foo/baz
+  call baz
+ end function
+ !REF: /m/bar
+ subroutine bar
+  print *, "in bar"
+ end subroutine
+end module
+!DEF: /demo MainProgram
+program demo
+ !REF: /m
+ use :: m
+ !DEF: /demo/bar (Subroutine) Use
+ !DEF: /demo/p EXTERNAL, POINTER (Subroutine) ProcEntity
+ procedure(bar), pointer :: p
+ !REF: /demo/p
+ !DEF: /demo/foo (Function) Use
+ p => foo()
+ !REF: /demo/p
+ call p
+end program