[flang] Avoid crash in statement function error case

[klausler]

Summary

The predicate IsPureProcedure() crashes with infinite
recursion when presented with mutually recursive statement
functions -- an error case that should be recoverable.
Fix by adding a visited set.

Fixes bug https://github.com/llvm/llvm-project/issues/63231

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Evaluate/tools.cpp

 
 bool IsVariableName(const Symbol &original) {
   const Symbol &ultimate{original.GetUltimate()};
   return !IsNamedConstant(ultimate) &&
       (ultimate.has<ObjectEntityDetails>() ||
           ultimate.has<AssocEntityDetails>());
 }
 
-bool IsPureProcedure(const Symbol &original) {
+static bool IsPureProcedureImpl(
+    const Symbol &original, semantics::UnorderedSymbolSet &set) {
   // An ENTRY is pure if its containing subprogram is
   const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))};
+  if (set.find(symbol) != set.end()) {
+    return true;
+  }
+  set.emplace(symbol);
   if (const auto *procDetails{symbol.detailsIf<ProcEntityDetails>()}) {
     if (procDetails->procInterface()) {
       // procedure with a pure interface
-      return IsPureProcedure(*procDetails->procInterface());
+      return IsPureProcedureImpl(*procDetails->procInterface(), set);
     }
   } else if (const auto *details{symbol.detailsIf<ProcBindingDetails>()}) {
-    return IsPureProcedure(details->symbol());
+    return IsPureProcedureImpl(details->symbol(), set);
   } else if (!IsProcedure(symbol)) {
     return false;
   }
   if (IsStmtFunction(symbol)) {
     // Section 15.7(1) states that a statement function is PURE if it does not
     // reference an IMPURE procedure or a VOLATILE variable
     if (const auto &expr{symbol.get<SubprogramDetails>().stmtFunction()}) {
       for (const SymbolRef &ref : evaluate::CollectSymbols(*expr)) {
         if (&*ref == &symbol) {
           return false; // error recovery, recursion is caught elsewhere
         }
-        if (IsFunction(*ref) && !IsPureProcedure(*ref)) {
+        if (IsFunction(*ref) && !IsPureProcedureImpl(*ref, set)) {
           return false;
         }
         if (ref->GetUltimate().attrs().test(Attr::VOLATILE)) {
           return false;
         }
       }
     }
     return true; // statement function was not found to be impure
   }
   return symbol.attrs().test(Attr::PURE) ||
       (symbol.attrs().test(Attr::ELEMENTAL) &&
           !symbol.attrs().test(Attr::IMPURE));
 }
 
+bool IsPureProcedure(const Symbol &original) {
+  semantics::UnorderedSymbolSet set;
+  return IsPureProcedureImpl(original, set);
+}
+
 bool IsPureProcedure(const Scope &scope) {
   const Symbol *symbol{scope.GetSymbol()};
   return symbol && IsPureProcedure(*symbol);
 }
 
 bool IsElementalProcedure(const Symbol &original) {
   // An ENTRY is elemental if its containing subprogram is
   const Symbol &symbol{DEREF(GetMainEntry(&original.GetUltimate()))};

flang/test/Semantics/stmt-func01.f90

program main
   sf7(n) = explicit(n)
   real :: a(3) = [1., 2., 3.]
   !PORTABILITY: Statement function 'sf8' should not pass an array argument that is not a whole array
   sf8(n) = sum(a(1:2))
   sf8a(n) = sum(a) ! ok
   integer :: sf9
   !ERROR: Defining expression of statement function 'sf9' cannot be converted to its result type INTEGER(4)
   sf9(n) = "bad"
-  sf10 = 1.
+  !ERROR: Statement function 'sf10' may not reference another statement function 'sf11' that is defined later
+  sf10(n) = sf11(n)
+  sf11(n) = sf10(n) ! mutual recursion, caused crash
+  sf13 = 1.
  contains
   real function explicit(x,y)
     integer, intent(in) :: x
     integer, intent(in), optional :: y
     explicit = x
   end function
   pure function arr()
     real :: arr(2)
     arr = [1., 2.]
   end function
   subroutine foo
     !PORTABILITY: An implicitly typed statement function should not appear when the same symbol is available in its host scope
-    sf10(x) = 2.*x
+    sf13(x) = 2.*x
   end subroutine
 end