[flang] Detect circularly defined interfaces of procedures

[PeteSteinfeld]

Summary

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.

[awarzynski]

Thank you for fixing this so quickly @PeteSteinfeld !

The patch was originally reviewed and accepted in https://reviews.llvm.org/D97201. This an updated version to make sure that this change works fine regardless of the underlying platform.

This change was previously reverted because resolve102.f90 was failing in our public Flang builders (the AAtch64 and PowerPC ones). I tested this updated patch on an AArch64 machine and can confirm that resolve102.f90 is no longer failing. The non-determinism in the output that was causing the failure has been removed by updating GetSeenProcs (see https://reviews.llvm.org/D97749 for context).

LGTM!

[kiranchandramohan]

I see a failure in the buildbot.
https://lab.llvm.org/buildbot/#/builders/33/builds/2845

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:25: error: loop variable 'procInCycle' of type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' creates a copy from type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' [-Werror,-Wrange-loop-construct]

for (const auto procInCycle : procsInCycle) {
                ^

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:14: note: use reference type 'const Fortran::common::Reference<const Fortran::semantics::Symbol> &' to prevent copying

for (const auto procInCycle : procsInCycle) {
     ^~~~~~~~~~~~~~~~~~~~~~~~
                &

[PeteSteinfeld]

In D97774#2598541, @kiranchandramohan wrote:

I see a failure in the buildbot.
https://lab.llvm.org/buildbot/#/builders/33/builds/2845

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:25: error: loop variable 'procInCycle' of type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' creates a copy from type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' [-Werror,-Wrange-loop-construct]

for (const auto procInCycle : procsInCycle) {
                ^

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:14: note: use reference type 'const Fortran::common::Reference<const Fortran::semantics::Symbol> &' to prevent copying

for (const auto procInCycle : procsInCycle) {
     ^~~~~~~~~~~~~~~~~~~~~~~~
                &

Thanks, @kiranchandramohan. I'll fix this.

[PeteSteinfeld]

In D97774#2598594, @PeteSteinfeld wrote:

In D97774#2598541, @kiranchandramohan wrote:

I see a failure in the buildbot.
https://lab.llvm.org/buildbot/#/builders/33/builds/2845

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:25: error: loop variable 'procInCycle' of type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' creates a copy from type 'const Fortran::common::Reference<const Fortran::semantics::Symbol>' [-Werror,-Wrange-loop-construct]

for (const auto procInCycle : procsInCycle) {
                ^

/home/flang/flang-aarch64-ubuntu-clang/flang-aarch64-ubuntu-clang/llvm-project/flang/lib/Semantics/resolve-names.cpp:3655:14: note: use reference type 'const Fortran::common::Reference<const Fortran::semantics::Symbol> &' to prevent copying

for (const auto procInCycle : procsInCycle) {
     ^~~~~~~~~~~~~~~~~~~~~~~~
                &

Thanks, @kiranchandramohan. I'll fix this.

I just pushed a change that should fix this.

[kiranchandramohan]

Thanks @PeteSteinfeld.

[tskeith]

flang/include/flang/Semantics/symbol.h

600

I don't like keeping an operator< that is only valid in some cases. It took a long time to find the bug with SymbolSet and errorSymbols_ and the presence of this function makes it easy to introduce another similar bug.

I think it would be better not to provide a default ordering of symbols, or to provide one that is always valid. Ordering by symbol address is valid, though may result in an unexpected order. Or we could add a serial number to symbols and sort them using that, i.e. in order of creation.

[klausler]

flang/include/flang/Semantics/symbol.h

600

I concur, and will soon propose replacing SymbolSet with multiple types whose collating order (if any) is more clear.

Most SymbolSet use cases really just need to be an unordered collection of Symbol pointers. The other cases might be better served as maps and multimaps from name positions or name values to Symbols.

[PeteSteinfeld]

Note that we could use the initial address in the cooked character stream as the basis for the "<" operator. I used that in an earlier implementation, and it worked fine and was immune to changes caused by calls to ReplaceName(). But it has the potential problem that there may be cases where we're comparing symbols from .mod files. Peter's solution of serial numbers would fix this.

Note also that I believe that currently, all sets of symbols in the compiler are declared as SymbolSet, which is an unordered set.

flang/include/flang/Semantics/semantics.h

private:
   parser::Messages messages_;
   evaluate::FoldingContext foldingContext_;
   ConstructStack constructStack_;
   struct IndexVarInfo {
     parser::CharBlock location;
     IndexVarKind kind;
   };
   std::map<SymbolRef, const IndexVarInfo> activeIndexVars_;
-  std::set<SymbolRef> errorSymbols_;
+  SymbolSet errorSymbols_;
   std::set<std::string> tempNames_;
 };
 
 class Semantics {
 public:
   explicit Semantics(SemanticsContext &context, parser::Program &program,
       parser::CharBlock charBlock, bool debugModuleWriter = false)
       : context_{context}, program_{program} {

flang/include/flang/Semantics/symbol.h

 #define FORTRAN_SEMANTICS_SYMBOL_H_
 
 #include "type.h"
 #include "flang/Common/Fortran.h"
 #include "flang/Common/enum-set.h"
 #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 {
 class raw_ostream;
 }
 
 namespace Fortran::semantics {
 
return std::visit(common::visitors{
                           [](const auto &) { return false; },
                       },
         details_);
   }
 
   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();
   }
 
   int Rank() const {
     return std::visit(
         common::visitors{
             [](const SubprogramDetails &sd) {
               return sd.isFunction() ? sd.result().Rank() : 0;
             },
return std::visit(
       },
       details_);
 }
 
 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
 
 // Define required  info so that SymbolRef can be used inside llvm::DenseMap.
 namespace llvm {
 template <> struct DenseMapInfo<Fortran::semantics::SymbolRef> {
   static inline Fortran::semantics::SymbolRef getEmptyKey() {
     auto ptr = DenseMapInfo<const Fortran::semantics::Symbol *>::getEmptyKey();

flang/lib/Evaluate/characteristics.cpp

DummyProcedure::DummyProcedure(Procedure &&p)
     : procedure{new Procedure{std::move(p)}} {}
 
 bool DummyProcedure::operator==(const DummyProcedure &that) const {
   return attrs == that.attrs && intent == that.intent &&
       procedure.value() == that.procedure.value();
 }
 
 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;
 }
 
 // These functions with arguments of type SymbolSet are used with mutually
 // recursive calls when characterizing a Procedure, a DummyArgument, or a
 // DummyProcedure to detect circularly defined procedures as required by
 // 15.4.3.6, paragraph 2.
 static std::optional<DummyArgument> CharacterizeDummyArgument(
     const semantics::Symbol &symbol, FoldingContext &context,
     semantics::SymbolSet &seenProcs);
 
 static std::optional<Procedure> CharacterizeProcedure(
     const semantics::Symbol &original, FoldingContext &context,
     semantics::SymbolSet &seenProcs) {
   Procedure result;
   const auto &symbol{original.GetUltimate()};
   if (seenProcs.find(symbol) != seenProcs.end()) {
     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;
   }
   seenProcs.insert(symbol);
   CopyAttrs<Procedure, Procedure::Attr>(symbol, result,
       {
           {semantics::Attr::PURE, Procedure::Attr::Pure},
           {semantics::Attr::ELEMENTAL, Procedure::Attr::Elemental},

flang/lib/Semantics/resolve-names.cpp

if (context().HasError(symbol) || symbol.has<T>()) {
             name, symbol, "'%s' is already declared as an object"_err_en_US);
       }
     } else if (!CheckPossibleBadForwardRef(symbol)) {
       SayAlreadyDeclared(name, symbol);
     }
     context().SetError(symbol);
     return symbol;
   }
+  bool HasCycle(const Symbol &, const ProcInterface &);
 };
 
 // Resolve construct entities and statement entities.
 // Check that construct names don't conflict with other names.
 class ConstructVisitor : public virtual DeclarationVisitor {
 public:
   bool Pre(const parser::ConcurrentHeader &);
   bool Pre(const parser::LocalitySpec::Local &);
return !symbol.GetType() &&
                      },
                      [](const auto &) { return false; },
                  },
           symbol.details());
 }
 
 void ScopeHandler::ApplyImplicitRules(
     Symbol &symbol, bool allowForwardReference) {
-  if (!NeedsType(symbol)) {
+  if (context().HasError(symbol) || !NeedsType(symbol)) {
     return;
   }
   if (const DeclTypeSpec * type{GetImplicitType(symbol)}) {
     symbol.set(Symbol::Flag::Implicit);
     symbol.SetType(*type);
     return;
   }
   if (symbol.has<ProcEntityDetails>() && !symbol.attrs().test(Attr::EXTERNAL)) {
if (!arraySpec().empty() || !coarraySpec().empty()) {
     SetBindNameOn(symbol);
     if (symbol.attrs().test(Attr::EXTERNAL)) {
       ConvertToProcEntity(symbol);
     }
     return symbol;
   }
 }
 
+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)};
   if (auto *details{symbol.detailsIf<ProcEntityDetails>()}) {
     if (details->IsInterfaceSet()) {
       SayWithDecl(name, symbol,
           "The interface for procedure '%s' has already been "
           "declared"_err_en_US);
       context().SetError(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()->test(Symbol::Flag::Subroutine)) {
-          symbol.set(Symbol::Flag::Subroutine);
-        }
-      }
-      details->set_interface(interface);
-      SetBindNameOn(symbol);
-      SetPassNameOn(symbol);
-    }
-  }
+    } else if (HasCycle(symbol, interface)) {
+      return symbol;
+    } else if (interface.type()) {
   return symbol;
 }
 
 Symbol &DeclarationVisitor::DeclareObjectEntity(
     const parser::Name &name, Attrs attrs) {
   Symbol &symbol{DeclareEntity<ObjectEntityDetails>(name, attrs)};
   if (auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
     if (auto *type{GetDeclTypeSpec()}) {
if (!NameIsKnownOrIntrinsic(name)) {
     Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
     Resolve(name, symbol);
   }
   return name.symbol;
 }
 
 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,
           symbol->name());
     }
   }
 }
 

flang/test/Semantics/resolve102.f90

 ! 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)
 
   contains
     subroutine sub(p2)
       procedure(p) :: p2
     end subroutine
 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)
       import p
       procedure(p) :: p2
     end subroutine
   end interface
   call p(sub)
 end program
 
 Program mutual
   Procedure(sub1) :: p
 
   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
 
     Subroutine sub(p2)
       Procedure(sub1) :: p2
     End Subroutine
 End Program
 
 Program mutual1
   Procedure(sub1) :: p
 
   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
 
     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