[flang] Detect circularly defined interfaces of procedures

psteinfeld · psteinfeld · commit 95540f9dbf03 · 2021-03-02T10:53:44.000-08:00
It's possible to define a procedure whose interface depends on a procedure which has an interface that depends on the original procedure. Such a circular definition was causing the compiler to fall into an infinite loop when resolving the name of the second procedure. It's also possible to create circular dependency chains of more than two procedures. I fixed this by adding the function HasCycle() to the class DeclarationVisitor and calling it from DeclareProcEntity() to detect procedures with such circularly defined interfaces. I marked the associated symbols of such procedures by calling SetError() on them. When processing subsequent procedures, I called HasError() before attempting to analyze their interfaces. Unfortunately, this did not work. With help from Tim, we determined that the SymbolSet used to track the erroneous symbols was instantiated using a "<" operator which was defined using the location of the name of the procedure. But the location of the procedure name was being changed by a call to ReplaceName() between the times that the calls to SetError() and HasError() were made. This caused HasError() to incorrectly report that a symbol was not in the set of erroneous symbols. I fixed this by changing SymbolSet to be an unordered set that uses the contents of the name of the symbol as the basis for its hash function. This works because the contents of the name of the symbol is preserved by ReplaceName() even though its location changes. I also fixed the error message used when reporting recursively defined dummy procedure arguments by removing extra apostrophes and sorting the list of symbols. I also added tests that will crash the compiler without this change. Note that the "<" operator is used in other contexts, for example, in the map of characterized procedures, maps of items in equivalence sets, maps of structure constructor values, ... All of these situations happen after name resolution has been completed and all calls to ReplaceName() have already happened and thus are not subject to the problem I ran into when ReplaceName() was called when processing procedure entities. Note also that the implementation of the "<" operator uses the relative location in the cooked character stream as the basis of its implementation. This is potentially problematic when symbols from diffent compilation units (for example symbols originating in .mod files) are put into the same map since their names will appear in two different source streams which may not be allocated in the same relative positions in memory. But I was unable to create a test that caused a problem. Using a direct comparison of the content of the name of the symbol in the "<" operator has problems. Symbols in enclosing or parallel scopes can have the same name. Also using the location of the symbol in the cooked character stream has the advantage that it preserves the the order of the symbols in a structure constructor constant, which makes matching the values with the symbols relatively easy. This patch supersedes D97749. Differential Revision: https://reviews.llvm.org/D97774
diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h
@@ -199,7 +199,7 @@ class SemanticsContext {
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
-  std::set<SymbolRef> errorSymbols_;
+  SymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
 };
 
diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h
@@ -15,9 +15,10 @@
 #include "flang/Common/reference.h"
 #include "llvm/ADT/DenseMapInfo.h"
 #include <array>
+#include <functional>
 #include <list>
 #include <optional>
-#include <set>
+#include <unordered_set>
 #include <vector>
 
 namespace llvm {
@@ -595,7 +596,7 @@ class Symbol {
   bool operator==(const Symbol &that) const { return this == &that; }
   bool operator!=(const Symbol &that) const { return !(*this == that); }
   bool operator<(const Symbol &that) const {
-    // For sets of symbols: collate them by source location
+    // For maps of symbols: collate them by source location
     return name_.begin() < that.name_.begin();
   }
 
@@ -765,7 +766,13 @@ inline bool operator<(SymbolRef x, SymbolRef y) { return *x < *y; }
 inline bool operator<(MutableSymbolRef x, MutableSymbolRef y) {
   return *x < *y;
 }
-using SymbolSet = std::set<SymbolRef>;
+struct SymbolHash {
+  std::size_t operator()(SymbolRef symRef) const {
+    std::hash<std::string> hasher;
+    return hasher(symRef->name().ToString());
+  }
+};
+using SymbolSet = std::unordered_set<SymbolRef, SymbolHash>;
 
 } // namespace Fortran::semantics
 
diff --git a/flang/lib/Evaluate/characteristics.cpp b/flang/lib/Evaluate/characteristics.cpp
@@ -344,9 +344,13 @@ bool DummyProcedure::operator==(const DummyProcedure &that) const {
 }
 
 static std::string GetSeenProcs(const semantics::SymbolSet &seenProcs) {
+  // Sort the symbols so that they appear in the same order on all platforms
+  std::vector<SymbolRef> sorter{seenProcs.begin(), seenProcs.end()};
+  std::sort(sorter.begin(), sorter.end());
+
   std::string result;
   llvm::interleave(
-      seenProcs,
+      sorter,
       [&](const SymbolRef p) { result += '\'' + p->name().ToString() + '\''; },
       [&]() { result += ", "; });
   return result;
@@ -369,7 +373,7 @@ static std::optional<Procedure> CharacterizeProcedure(
     std::string procsList{GetSeenProcs(seenProcs)};
     context.messages().Say(symbol.name(),
         "Procedure '%s' is recursively defined.  Procedures in the cycle:"
-        " '%s'"_err_en_US,
+        " %s"_err_en_US,
         symbol.name(), procsList);
     return std::nullopt;
   }
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
@@ -1003,6 +1003,7 @@ class DeclarationVisitor : public ArraySpecVisitor,
     context().SetError(symbol);
     return symbol;
   }
+  bool HasCycle(const Symbol &, const ProcInterface &);
 };
 
 // Resolve construct entities and statement entities.
@@ -2132,7 +2133,7 @@ static bool NeedsType(const Symbol &symbol) {
 
 void ScopeHandler::ApplyImplicitRules(
     Symbol &symbol, bool allowForwardReference) {
-  if (!NeedsType(symbol)) {
+  if (context().HasError(symbol) || !NeedsType(symbol)) {
     return;
   }
   if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
@@ -3641,6 +3642,35 @@ Symbol &DeclarationVisitor::DeclareUnknownEntity(
   }
 }
 
+bool DeclarationVisitor::HasCycle(
+    const Symbol &procSymbol, const ProcInterface &interface) {
+  SymbolSet procsInCycle;
+  procsInCycle.insert(procSymbol);
+  const ProcInterface *thisInterface{&interface};
+  bool haveInterface{true};
+  while (haveInterface) {
+    haveInterface = false;
+    if (const Symbol * interfaceSymbol{thisInterface->symbol()}) {
+      if (procsInCycle.count(*interfaceSymbol) > 0) {
+        for (const auto procInCycle : procsInCycle) {
+          Say(procInCycle->name(),
+              "The interface for procedure '%s' is recursively "
+              "defined"_err_en_US,
+              procInCycle->name());
+          context().SetError(*procInCycle);
+        }
+        return true;
+      } else if (const auto *procDetails{
+                     interfaceSymbol->detailsIf<ProcEntityDetails>()}) {
+        haveInterface = true;
+        thisInterface = &procDetails->interface();
+        procsInCycle.insert(*interfaceSymbol);
+      }
+    }
+  }
+  return false;
+}
+
 Symbol &DeclarationVisitor::DeclareProcEntity(
     const parser::Name &name, Attrs attrs, const ProcInterface &interface) {
   Symbol &symbol{DeclareEntity<ProcEntityDetails>(name, attrs)};
@@ -3650,20 +3680,20 @@ Symbol &DeclarationVisitor::DeclareProcEntity(
           "The interface for procedure '%s' has already been "
           "declared"_err_en_US);
       context().SetError(symbol);
-    } else {
-      if (interface.type()) {
+    } else if (HasCycle(symbol, interface)) {
+      return symbol;
+    } else if (interface.type()) {
+      symbol.set(Symbol::Flag::Function);
+    } else if (interface.symbol()) {
+      if (interface.symbol()->test(Symbol::Flag::Function)) {
         symbol.set(Symbol::Flag::Function);
-      } else if (interface.symbol()) {
-        if (interface.symbol()->test(Symbol::Flag::Function)) {
-          symbol.set(Symbol::Flag::Function);
-        } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
-          symbol.set(Symbol::Flag::Subroutine);
-        }
+      } else if (interface.symbol()->test(Symbol::Flag::Subroutine)) {
+        symbol.set(Symbol::Flag::Subroutine);
       }
-      details->set_interface(interface);
-      SetBindNameOn(symbol);
-      SetPassNameOn(symbol);
     }
+    details->set_interface(interface);
+    SetBindNameOn(symbol);
+    SetPassNameOn(symbol);
   }
   return symbol;
 }
@@ -5005,7 +5035,7 @@ Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
 
 void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
   if (const Symbol * symbol{name.symbol}) {
-    if (!symbol->HasExplicitInterface()) {
+    if (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) {
       Say(name,
           "'%s' must be an abstract interface or a procedure with "
           "an explicit interface"_err_en_US,
diff --git a/flang/test/Semantics/resolve102.f90 b/flang/test/Semantics/resolve102.f90
@@ -1,15 +1,15 @@
 ! RUN: %S/test_errors.sh %s %t %f18
 
 ! Tests for circularly defined procedures
-!ERROR: Procedure 'sub' is recursively defined.  Procedures in the cycle: ''sub', 'p2''
+!ERROR: Procedure 'sub' is recursively defined.  Procedures in the cycle: 'sub', 'p2'
 subroutine sub(p2)
   PROCEDURE(sub) :: p2
 
   call sub()
 end subroutine
 
 subroutine circular
-  !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: ''p', 'sub', 'p2''
+  !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
   procedure(sub) :: p
 
   call p(sub)
@@ -21,7 +21,7 @@ subroutine sub(p2)
 end subroutine circular
 
 program iface
-  !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: ''p', 'sub', 'p2''
+  !ERROR: Procedure 'p' is recursively defined.  Procedures in the cycle: 'p', 'sub', 'p2'
   procedure(sub) :: p
   interface
     subroutine sub(p2)
@@ -38,7 +38,7 @@ Program mutual
   Call p(sub)
 
   contains
-    !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: ''p', 'sub1', 'arg''
+    !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'p', 'sub1', 'arg'
     Subroutine sub1(arg)
       procedure(sub1) :: arg
     End Subroutine
@@ -54,7 +54,7 @@ Program mutual1
   Call p(sub)
 
   contains
-    !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: ''p', 'sub1', 'arg', 'sub', 'p2''
+    !ERROR: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'p', 'sub1', 'arg', 'sub', 'p2'
     Subroutine sub1(arg)
       procedure(sub) :: arg
     End Subroutine
@@ -63,3 +63,24 @@ Subroutine sub(p2)
       Procedure(sub1) :: p2
     End Subroutine
 End Program
+
+program twoCycle
+  !ERROR: The interface for procedure 'p1' is recursively defined
+  !ERROR: The interface for procedure 'p2' is recursively defined
+  procedure(p1) p2
+  procedure(p2) p1
+  call p1
+  call p2
+end program
+
+program threeCycle
+  !ERROR: The interface for procedure 'p1' is recursively defined
+  !ERROR: The interface for procedure 'p2' is recursively defined
+  procedure(p1) p2
+  !ERROR: The interface for procedure 'p3' is recursively defined
+  procedure(p2) p3
+  procedure(p3) p1
+  call p1
+  call p2
+  call p3
+end program
