[flang-commits] [flang] 8c407f4 - [flang] Allow ENTRY function result symbol usage before the ENTRY

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-05-09T19:12:23-07:00
New Revision: 8c407f4a1121ac3eaf46ca6e92f0976c196ce35b

URL: https://github.com/llvm/llvm-project/commit/8c407f4a1121ac3eaf46ca6e92f0976c196ce35b
DIFF: https://github.com/llvm/llvm-project/commit/8c407f4a1121ac3eaf46ca6e92f0976c196ce35b.diff

LOG: [flang] Allow ENTRY function result symbol usage before the ENTRY

In a function, ENTRY E without an explicit RESULT() creates a
function result entity also named E that is storage associated with
the enclosing function's result.  f18 was emitting an incorrect error
message if that function result E was referenced without any
declaration prior to its ENTRY statement when it should have been
implicitly declared instead.

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

Added: 
    

Modified: 
    flang/lib/Semantics/resolve-names.cpp
    flang/test/Semantics/entry01.f90

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 114b64508c76..062c016cc738 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -821,7 +821,8 @@ class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
 
   bool BeginSubprogram(const parser::Name &, Symbol::Flag,
       bool hasModulePrefix = false,
-      const parser::LanguageBindingSpec * = nullptr);
+      const parser::LanguageBindingSpec * = nullptr,
+      const ProgramTree::EntryStmtList * = nullptr);
   bool BeginMpSubprogram(const parser::Name &);
   void PushBlockDataScope(const parser::Name &);
   void EndSubprogram();
@@ -3373,12 +3374,16 @@ void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
   entryDetails.set_entryScope(inclusiveScope);
   if (inFunction) {
     // Create the entity to hold the function result, if necessary.
-    Symbol *resultSymbol{nullptr};
     auto &effectiveResultName{*(resultName ? resultName : &name)};
-    resultSymbol = FindInScope(currScope(), effectiveResultName);
+    Symbol *resultSymbol{FindInScope(currScope(), effectiveResultName)};
     if (resultSymbol) { // C1574
       common::visit(
-          common::visitors{[](EntityDetails &x) { x.set_funcResult(true); },
+          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 &) {
@@ -3388,6 +3393,11 @@ void SubprogramVisitor::PostEntryStmt(const parser::EntryStmt &stmt) {
                 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);
@@ -3509,7 +3519,8 @@ bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
 // A subprogram or interface declared with SUBROUTINE or FUNCTION
 bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
     Symbol::Flag subpFlag, bool hasModulePrefix,
-    const parser::LanguageBindingSpec *bindingSpec) {
+    const parser::LanguageBindingSpec *bindingSpec,
+    const ProgramTree::EntryStmtList *entryStmts) {
   if (hasModulePrefix && currScope().IsGlobal()) { // C1547
     Say(name,
         "'%s' is a MODULE procedure which must be declared within a "
@@ -3546,6 +3557,21 @@ bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
   }
   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);
+        }
+      }
+    }
   }
   return true;
 }
@@ -7364,7 +7390,7 @@ bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
   case ProgramTree::Kind::Function:
   case ProgramTree::Kind::Subroutine:
     return BeginSubprogram(node.name(), node.GetSubpFlag(),
-        node.HasModulePrefix(), node.bindingSpec());
+        node.HasModulePrefix(), node.bindingSpec(), &node.entryStmts());
   case ProgramTree::Kind::MpSubprogram:
     return BeginMpSubprogram(node.name());
   case ProgramTree::Kind::Module:

diff  --git a/flang/test/Semantics/entry01.f90 b/flang/test/Semantics/entry01.f90
index 2a95d6cc5906..44065e36100d 100644
--- a/flang/test/Semantics/entry01.f90
+++ b/flang/test/Semantics/entry01.f90
@@ -108,8 +108,8 @@ function ifunc()
   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
-  !ERROR: 'isubr' was previously called as a subroutine
   entry isubr()
   continue ! force transition to execution part
   entry implicit()
@@ -204,3 +204,11 @@ function inone
   !ERROR: No explicit type declared for 'implicitbad2'
   entry implicitbad2
 end
+
+module m5
+ contains
+  real function setBefore
+    ent = 1.0
+    entry ent
+  end function
+end module