[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 name of the procedure. But 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 unordered.

I also added tests that will crash the compiler without this change.

[klausler]

flang/include/flang/Semantics/symbol.h

607

Heap addresses are arbitrary and cannot be expected to have relationships that are portable. This change is going to lead to spurious test failures esp. across platforms. You're going to have to order the symbols via the actual characters in their names instead.

[PeteSteinfeld]

flang/include/flang/Semantics/symbol.h

607

Good catch. Will do.

[tskeith]

flang/include/flang/Semantics/symbol.h

607

Heap addresses are arbitrary and cannot be expected to have relationships that are portable. This change is going to lead to spurious test failures esp. across platforms. You're going to have to order the symbols via the actual characters in their names instead.

An alternative is to make SymbolSet be an std::unordered_set and explicitly sort the symbols when the order matters, e.g. in .mod files.

[PeteSteinfeld]

Responding to Peter's and Tim's comments. The "<" operator is used not only
for SymbolSet, but it's also used to sort the elements in a SymbolVector in
several places. The simplest and least disruptive fix was to follow another
suggestion from Tim to record the initial value of a symbol's name and use that
initial value as the basis for the "<" operator. This change makes the result
of the "<" operator immune to calls to "ReplaceName()".

[PeteSteinfeld]

flang/include/flang/Semantics/symbol.h

607

I tried going down the path of making SymbolSet be unordered but the resulting changes were pretty messy, and I gave up in favor of another suggestion from Tim -- to record the initial value of the symbol's name and use that as the basis for the "<" operator.

[tskeith]

Looks good to me.

flang/test/Semantics/resolve102.f90

24

Can you remove the extra quotes?

[PeteSteinfeld]

flang/include/flang/Semantics/symbol.h

607

After examining several alternatives, I've concluded that making SymbolSet unordered is the least disruptive solution. More information in an update soon to follow.

[PeteSteinfeld]

I changed the solution to the problem with SymbolSet having an inconsistent "<"
operator by making it unordered.

I investigated changing the definition of the "<" operator, but it's used in
many different places as the key for map types and to sort symbols.

Peter has noted that the current implementation of the "<" operator for Symbol
relies on the fact that its arguments are in the same cooked character stream.
This assumption is violated when at least one of the symbols being compared
comes from a .mod file.

[PeteSteinfeld]

Fixed the formatting of an error message as suggested by Tim.

[kiranchandramohan]

@PeteSteinfeld

The aarch64 flang buildbots are failing since this commit.
https://lab.llvm.org/buildbot/#/builders/32/builds/3480
The x86 buildbot is passing. https://lab.llvm.org/buildbot/#/builders/132

From the failure it looks like a test expectation issue. Not sure, but it could be that the order/start/direction of the cycle could be different for aarch64, x86.

[awarzynski]

In D97201#2593487, @kiranchandramohan wrote:

@PeteSteinfeld

The aarch64 flang buildbots are failing since this commit.
https://lab.llvm.org/buildbot/#/builders/32/builds/3480
The x86 buildbot is passing. https://lab.llvm.org/buildbot/#/builders/132

From the failure it looks like a test expectation issue. Not sure, but it could be that the order/start/direction of the cycle could be different for aarch64, x86.

I believe that the problem stems from the switch from std::set to std::unordered_set. As a result, the order in which things are printed is implementation-defined (and will differ between platforms). However, that switch is also part of the fix here - I assume that reverting it is not desirable.

One other alternative would be to leverage FileCheck and to use regex patterns in the tests. That would make the test less fragile, but I'm under the impression that people do prefer to use test_errors.sh instead (previous discussion here). Just to demonstrate how a ported test would look, I've updated resolve102.f90 and pasted it at the bottom of this message (passes on AArch64).

@PeteSteinfeld , thank you for working on this! As this is causing a breakage in 6 out of 8 of Flang's public buildbots, I will revert this for now (I'm not sure what the fix should be). Please let me know if I can help to re-land this change!

PORTED TEST

! RUN: not %f18 %s 2>&1 | FileCheck %s

! Tests for circularly defined procedures
! CHECK: Procedure 'sub' is recursively defined.  Procedures in the cycle: '{{p2|sub}}', '{{p2|sub}}'
subroutine sub(p2)
  PROCEDURE(sub) :: p2

  call sub()
end subroutine

subroutine circular
  ! CHECK: Procedure 'p' is recursively defined.  Procedures in the cycle: '{{p|p2|sub}}', '{{p|p2|sub}}', '{{p|p2|sub}}'
  procedure(sub) :: p

  call p(sub)

  contains
    subroutine sub(p2)
      procedure(p) :: p2
    end subroutine
end subroutine circular

program iface
  ! CHECK: Procedure 'p' is recursively defined.  Procedures in the cycle: '{{p|p2|sub}}', '{{p|p2|sub}}', '{{p|p2|sub}}'
  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
    ! CHECK:: Procedure 'sub1' is recursively defined.  Procedures in the cycle: '{{arg|p|sub1}}', '{{arg|p|sub1}}', '{{arg|p|sub1}}'
    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
    ! CHECK:: Procedure 'sub1' is recursively defined.  Procedures in the cycle: '{{p2|sub|arg|p|sub1}}', '{{p2|sub|arg|p|sub1}}', '{{p2|sub|arg|p|sub1}}', '{{p2|sub|arg|p|sub1}}', '{{p2|sub|arg|p|sub1}}'
    Subroutine sub1(arg)
      procedure(sub) :: arg
    End Subroutine

    Subroutine sub(p2)
      Procedure(sub1) :: p2
    End Subroutine
End Program

program twoCycle
  ! CHECK:: The interface for procedure 'p1' is recursively defined
  ! CHECK:: The interface for procedure 'p2' is recursively defined
  procedure(p1) p2
  procedure(p2) p1
  call p1
  call p2
end program

program threeCycle
  ! CHECK:: The interface for procedure 'p1' is recursively defined
  ! CHECK:: The interface for procedure 'p2' is recursively defined
  procedure(p1) p2
  ! CHECK:: The interface for procedure 'p3' is recursively defined
  procedure(p2) p3
  procedure(p3) p1
  call p1
  call p2
  call p3
end program

[PeteSteinfeld]

Superseded by D97749.

flang/include/flang/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 <list>
 #include <optional>
-#include <set>
+#include <unordered_set>
 #include <vector>
 
 namespace llvm {
 class raw_ostream;
 }
 
 namespace Fortran::semantics {
 
 /// A Symbol consists of common information (name, owner, and attributes)
 /// and details information specific to the kind of symbol, represented by the
 /// *Details classes.
 
 class Scope;
 class Symbol;
 class ProgramTree;
 
 using SymbolRef = common::Reference<const Symbol>;
 using SymbolVector = std::vector<SymbolRef>;
 using MutableSymbolRef = common::Reference<Symbol>;
 using MutableSymbolVector = std::vector<MutableSymbolRef>;
+struct SymbolHash {
+  std::size_t operator()(SymbolRef symRef) const {
+    return (std::size_t)(&symRef.get());
+  }
+};
+using SymbolSet = std::unordered_set<SymbolRef, SymbolHash>;
 
 // A module or submodule.
 class ModuleDetails {
 public:
   ModuleDetails(bool isSubmodule = false) : isSubmodule_{isSubmodule} {}
   bool isSubmodule() const { return isSubmodule_; }
   const Scope *scope() const { return scope_; }
   const Scope *ancestor() const; // for submodule; nullptr for module
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); }
+  // For maps using symbols as keys and sorting symbols.  Collate them by their
+  // position in the cooked character stream
   bool operator<(const Symbol &that) const {
-    // For sets of symbols: collate them by source location
-    return name_.begin() < that.name_.begin();
+    return sortName_ < that.sortName_;
   }
 
   int Rank() const {
     return std::visit(
         common::visitors{
             [](const SubprogramDetails &sd) {
               return sd.isFunction() ? sd.result().Rank() : 0;
             },
             [](const GenericDetails &) {
public:
   // If there is a parent component, return a pointer to its derived type spec.
   // The Scope * argument defaults to this->scope_ but should be overridden
   // for a parameterized derived type instantiation with the instance's scope.
   const DerivedTypeSpec *GetParentTypeSpec(const Scope * = nullptr) const;
 
 private:
   const Scope *owner_;
   SourceName name_;
+  const char *sortName_; // used in the "<" operator for sorting symbols
   Attrs attrs_;
   Flags flags_;
   Scope *scope_{nullptr};
   std::size_t size_{0}; // size in bytes
   std::size_t offset_{0}; // byte offset in scope or common block
   Details details_;
 
   Symbol() {} // only created in class Symbols

 // deleted.
 template <std::size_t BLOCK_SIZE> class Symbols {
 public:
   Symbol &Make(const Scope &owner, const SourceName &name, const Attrs &attrs,
       Details &&details) {
     Symbol &symbol = Get();
     symbol.owner_ = &owner;
     symbol.name_ = name;
+    symbol.sortName_ = name.begin();
     symbol.attrs_ = attrs;
     symbol.details_ = std::move(details);
     return symbol;
   }
 
 private:
   using blockType = std::array<Symbol, BLOCK_SIZE>;
   std::list<blockType *> blocks_;
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>;
 
 } // 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

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)) {
     std::optional<Symbol::Flag> functionOrSubroutineFlag;
     if (symbol.test(Symbol::Flag::Function)) {
       functionOrSubroutineFlag = Symbol::Flag::Function;
     } else if (symbol.test(Symbol::Flag::Subroutine)) {
       functionOrSubroutineFlag = Symbol::Flag::Subroutine;
     }
     if (IsIntrinsic(symbol.name(), functionOrSubroutineFlag)) {
       // type will be determined in expression semantics
       AcquireIntrinsicProcedureFlags(symbol);
       return;
     }
   }
   if (allowForwardReference && ImplicitlyTypeForwardRef(symbol)) {
     return;
   }
-  if (!context().HasError(symbol)) {
-    Say(symbol.name(), "No explicit type declared for '%s'"_err_en_US);
-    context().SetError(symbol);
-  }
-}
 
 // Extension: Allow forward references to scalar integer dummy arguments
 // to appear in specification expressions under IMPLICIT NONE(TYPE) when
 // what would otherwise have been their implicit type is default INTEGER.
 bool ScopeHandler::ImplicitlyTypeForwardRef(Symbol &symbol) {
   if (!inSpecificationPart_ || context().HasError(symbol) || !IsDummy(symbol) ||
       symbol.Rank() != 0 ||
       !context().languageFeatures().IsEnabled(
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: 'p2', 'sub'
 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: 'p2', 'p', 'sub'
   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: 'p2', 'p', 'sub'
   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: 'arg', 'p', 'sub1'
     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: 'p2', 'sub', 'arg', 'p', 'sub1'
     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