[flang] Fix symbol table bugs with ENTRY statements

Dummy arguments of ENTRY statements in execution parts were
not being created as objects, nor were they being implicitly
typed.

When the symbol corresponding to an alternate ENTRY point
already exists (by that name) due to having been referenced
in an earlier call, name resolution used to delete the extant
symbol.  This isn't the right thing to do -- the extant
symbol will be pointed to by parser::Name nodes in the parse
tree while no longer being part of any Scope.

Differential Review: https://reviews.llvm.org/D102948

Author: klausler

flang/lib/Semantics/resolve-names.cpp

@@ -746,6 +746,9 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
     std::optional<SourceName> source;
   } funcInfo_;
 
+  // Edits an existing symbol created for earlier calls to a subprogram or ENTRY
+  // so that it can be replaced by a later definition.
+  bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
   // Create a subprogram symbol in the current scope and push a new scope.
   void CheckExtantProc(const parser::Name &, Symbol::Flag);
   Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
@@ -3079,8 +3082,11 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
                       dummy->name(), "Previous declaration of '%s'"_en_US);
                 }},
             dummy->details());
+      } else if (inExecutionPart_) {
+        dummy = &MakeSymbol(*dummyName, ObjectEntityDetails{true});
+        ApplyImplicitRules(*dummy);
       } else {
-        dummy = &MakeSymbol(*dummyName, EntityDetails(true));
+        dummy = &MakeSymbol(*dummyName, EntityDetails{true});
       }
       entryDetails.add_dummyArg(*dummy);
     } else {
@@ -3096,20 +3102,11 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
   Symbol::Flag subpFlag{
       inFunction ? Symbol::Flag::Function : Symbol::Flag::Subroutine};
   Scope &outer{inclusiveScope.parent()}; // global or module scope
+  if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
+    attrs.set(Attr::PUBLIC);
+  }
   if (Symbol * extant{FindSymbol(outer, name)}) {
-    if (extant->has<ProcEntityDetails>()) {
-      if (!extant->test(subpFlag)) {
-        Say2(name,
-            subpFlag == Symbol::Flag::Function
-                ? "'%s' was previously called as a subroutine"_err_en_US
-                : "'%s' was previously called as a function"_err_en_US,
-            *extant, "Previous call of '%s'"_en_US);
-      }
-      if (extant->attrs().test(Attr::PRIVATE)) {
-        attrs.set(Attr::PRIVATE);
-      }
-      outer.erase(extant->name());
-    } else {
+    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);
@@ -3119,14 +3116,8 @@ void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
       return;
     }
   }
-  if (outer.IsModule() && !attrs.test(Attr::PRIVATE)) {
-    attrs.set(Attr::PUBLIC);
-  }
   Symbol &entrySymbol{MakeSymbol(outer, name.source, attrs)};
   entrySymbol.set_details(std::move(entryDetails));
-  if (outer.IsGlobal()) {
-    MakeExternal(entrySymbol);
-  }
   SetBindNameOn(entrySymbol);
   entrySymbol.set(subpFlag);
   Resolve(name, entrySymbol);
@@ -3186,24 +3177,37 @@ bool SubprogramVisitor::BeginSubprogram(
 
 void SubprogramVisitor::EndSubprogram() { PopScope(); }
 
+bool SubprogramVisitor::HandlePreviousCalls(
+    const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
+  if (const auto *proc{symbol.detailsIf<ProcEntityDetails>()}; proc &&
+      !proc->isDummy() &&
+      !symbol.attrs().HasAny(Attrs{Attr::INTRINSIC, Attr::POINTER})) {
+    // There's a symbol created for previous calls to this subprogram or
+    // ENTRY's name.  We have to replace that symbol in situ to avoid the
+    // obligation to rewrite symbol pointers in the parse tree.
+    if (!symbol.test(subpFlag)) {
+      Say2(name,
+          subpFlag == Symbol::Flag::Function
+              ? "'%s' was previously called as a subroutine"_err_en_US
+              : "'%s' was previously called as a function"_err_en_US,
+          symbol, "Previous call of '%s'"_en_US);
+    }
+    EntityDetails entity;
+    if (proc->type()) {
+      entity.set_type(*proc->type());
+    }
+    symbol.details() = std::move(entity);
+    return true;
+  } else {
+    return symbol.has<UnknownDetails>() || symbol.has<SubprogramNameDetails>();
+  }
+}
+
 void SubprogramVisitor::CheckExtantProc(
     const parser::Name &name, Symbol::Flag subpFlag) {
   if (auto *prev{FindSymbol(name)}) {
-    if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
-      // this subprogram was previously called, now being declared
-      if (!prev->test(subpFlag)) {
-        Say2(name,
-            subpFlag == Symbol::Flag::Function
-                ? "'%s' was previously called as a subroutine"_err_en_US
-                : "'%s' was previously called as a function"_err_en_US,
-            *prev, "Previous call of '%s'"_en_US);
-      }
-      EraseSymbol(name);
-    } else if (const auto *details{prev->detailsIf<EntityDetails>()}) {
-      if (!details->isDummy()) {
-        Say2(name, "Procedure '%s' was previously declared"_err_en_US, *prev,
-            "Previous declaration of '%s'"_en_US);
-      }
+    if (!IsDummy(*prev) && !HandlePreviousCalls(name, *prev, subpFlag)) {
+      SayAlreadyDeclared(name, *prev);
     }
   }
 }

flang/test/Semantics/resolve18.f90

@@ -98,7 +98,7 @@ subroutine s5
 module m6
   real :: f6
   interface g6
-  !ERROR: Procedure 'f6' was previously declared
+  !ERROR: 'f6' is already declared in this scoping unit
     real function f6()
     end function f6
   end interface g6
@@ -107,7 +107,7 @@ end module m6
 module m7
   integer :: f7
   interface g7
-    !ERROR: Procedure 'f7' was previously declared
+    !ERROR: 'f7' is already declared in this scoping unit
     real function f7()
     end function f7
   end interface g7
@@ -116,7 +116,7 @@ end module m7
 module m8
   real :: f8
   interface g8
-    !ERROR: Procedure 'f8' was previously declared
+    !ERROR: 'f8' is already declared in this scoping unit
     subroutine f8()
     end subroutine f8
   end interface g8