[flang] Do not ICE on recursive function definition in function result

[unterumarmung]

Summary

The following code causes the compiler to ICE in several places due to
lack of support of recursive procedure definitions through the function
result.

function foo() result(r)
  procedure(foo), pointer :: r
end function foo

[klausler]

flang/include/flang/Semantics/symbol.h

694

Your changes make Symbol::Rank() and Symbol::GetType() more expensive to call and liable to allocate/deallocate memory for all programs. Would it be sufficient to just use an integer argument to limit the call depth? That would avoid a crash in erroneous tests without affecting compilation for correct programs.

flang/lib/Semantics/check-declarations.cpp

1789

When generic is not GenericDetails, what is it?

[unterumarmung]

flang/include/flang/Semantics/symbol.h

694

That's a great idea! But, to be honest, I'm having a hard time coming up with an initial value for such argument. Is there a limit for number of nested calls of these functions for correct programs? Or, maybe, we should use some big enough value that probably is not encountered in correct programs, yet lets us avoid the stack overflow?

flang/lib/Semantics/check-declarations.cpp

1789

Well, the generic was written not by me. If I understand correctly, generic is a Symbol that meant to have the GenericDetails.

[klausler]

flang/include/flang/Semantics/symbol.h

694

There is not a limit in the standard, but something like 100 should work. And then you should crash with CHECK() instead of returning a rank of 0 or a null type.

flang/lib/Semantics/check-declarations.cpp

1789

Yes, but you're going out of your way to pass it to Characterize(), so I assume that you've encountered this case in a test somewhere. If you keep this call here, why does it apply only to functions? Fortran has generic subroutines as well.

[unterumarmung]

flang/include/flang/Semantics/symbol.h

694

Ok, I'll try it and submit the updated patch if it works

flang/lib/Semantics/check-declarations.cpp

1789

Well, if we delete this chunk of code and run the test, we will get an ICE in the lowering part of the compiler because we do not call the Characterize on foo or r (from the test) because they do not have GenericDetails. And because there's not any other compile errors, the execution of compiler successfully goes to the lowering, where it tries to generate Procedure for foo via Characterize and crashes there. I added the code here specifically for functions, to enable at least some semantic checks for the generic symbol.

This is not the best solution and I'd be glad to consider your (or anyone else's) advices how to make it better, if you have any.

[klausler]

flang/lib/Semantics/check-declarations.cpp

1789

Ok, but I don't think that the Function flag on the symbol means what you think. Try testing for .has<SubprogramDetails>() so that it works for functions and subroutines.

[unterumarmung]

flang/lib/Semantics/check-declarations.cpp

1789

I tried and it creates a lot of new error messages for resolve102.f90
For example, for sub1 in this chunk of test: https://github.com/llvm/llvm-project/blob/main/flang/test/Semantics/resolve102.f90#L51-L65 it generates 3 errors instead of 1:

./flang/test/Semantics/resolve102.f90:48:16: error: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'sub1', 'arg', 'sub', 'p2'
      Subroutine sub1(arg)
                 ^^^^
./flang/test/Semantics/resolve102.f90:48:16: error: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'sub1', 'arg'
      Subroutine sub1(arg)
                 ^^^^
./flang/test/Semantics/resolve102.f90:48:16: error: Procedure 'sub1' is recursively defined.  Procedures in the cycle: 'p', 'sub1', 'arg'
      Subroutine sub1(arg)
                 ^^^^

All the errors seem fair. Is it an acceptable behavior? If it is, I'll proceed with the change.
Personally, I think that "more errors is better" - because it can help fix erroneous code faster.

[unterumarmung]

Changed the recursion cycles approach

[unterumarmung]

Fixed changes

[unterumarmung]

flang/include/flang/Semantics/symbol.h

694

Well, I do not think, that we should crash here. The whole point of the change was not to emit the internal compiler error, but proceed with nullptr or rank of 0 to give a readable error.
I added the updated version of recursion handling but with returning invalid values.

[klausler]

flang/include/flang/Semantics/symbol.h

691

Braced initialization, please.

[unterumarmung]

Rebased, squashed commits, used braced initialization

[unterumarmung]

0 -> nullptr

flang/include/flang/Semantics/symbol.h

691

Oops..
Done!

[unterumarmung]

https://github.com/llvm/llvm-project/commit/488b9fd1030b1e75a6c3580d0a632009315e31f5

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 "flang/Common/visit.h"
 #include "llvm/ADT/DenseMapInfo.h"
+
 #include <array>
 #include <functional>
 #include <list>
 #include <optional>
 #include <set>
 #include <vector>
 
 namespace llvm {
return common::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); }
 
-  int Rank() const {
-    return common::visit(
-        common::visitors{
-            [](const SubprogramDetails &sd) {
-              return sd.isFunction() ? sd.result().Rank() : 0;
-            },
-            [](const GenericDetails &) {
-              return 0; /*TODO*/
-            },
-            [](const ProcBindingDetails &x) { return x.symbol().Rank(); },
-            [](const UseDetails &x) { return x.symbol().Rank(); },
-            [](const HostAssocDetails &x) { return x.symbol().Rank(); },
-            [](const ObjectEntityDetails &oed) { return oed.shape().Rank(); },
-            [](const ProcEntityDetails &ped) {
-              const Symbol *iface{ped.interface().symbol()};
-              return iface ? iface->Rank() : 0;
-            },
-            [](const AssocEntityDetails &aed) {
-              if (const auto &expr{aed.expr()}) {
-                if (auto assocRank{aed.rank()}) {
-                  return *assocRank;
-                } else {
-                  return expr->Rank();
-                }
-              } else {
-                return 0;
-              }
-            },
-            [](const auto &) { return 0; },
-        },
-        details_);
-  }
+  int Rank() const { return RankImpl(); }
 
   int Corank() const {
     return common::visit(
         common::visitors{
             [](const SubprogramDetails &sd) {
               return sd.isFunction() ? sd.result().Corank() : 0;
             },
             [](const GenericDetails &) {
private:
   Details details_;
 
   Symbol() {} // only created in class Symbols
   const std::string GetDetailsName() const;
   friend llvm::raw_ostream &operator<<(llvm::raw_ostream &, const Symbol &);
   friend llvm::raw_ostream &DumpForUnparse(
       llvm::raw_ostream &, const Symbol &, bool);
 
+  static constexpr int startRecursionDepth{100};
+
+  inline const DeclTypeSpec *GetTypeImpl(int depth = startRecursionDepth) const;
+  inline int RankImpl(int depth = startRecursionDepth) const {
+    if (depth-- == 0) {
+      return 0;
+    }
+    return common::visit(
+        common::visitors{
+            [&](const SubprogramDetails &sd) {
+              return sd.isFunction() ? sd.result().RankImpl(depth) : 0;
+            },
+            [](const GenericDetails &) {
+              return 0; /*TODO*/
+            },
+            [&](const ProcBindingDetails &x) {
+              return x.symbol().RankImpl(depth);
+            },
+            [&](const UseDetails &x) { return x.symbol().RankImpl(depth); },
+            [&](const HostAssocDetails &x) {
+              return x.symbol().RankImpl(depth);
+            },
+            [](const ObjectEntityDetails &oed) { return oed.shape().Rank(); },
+            [&](const ProcEntityDetails &ped) {
+              const Symbol *iface{ped.interface().symbol()};
+              return iface ? iface->RankImpl(depth) : 0;
+            },
+            [](const AssocEntityDetails &aed) {
+              if (const auto &expr{aed.expr()}) {
+                if (auto assocRank{aed.rank()}) {
+                  return *assocRank;
+                } else {
+                  return expr->Rank();
+                }
+              } else {
+                return 0;
+              }
+            },
+            [](const auto &) { return 0; },
+        },
+        details_);
+  }
   template <std::size_t> friend class Symbols;
   template <class, std::size_t> friend class std::array;
 };
 
 llvm::raw_ostream &operator<<(llvm::raw_ostream &, Symbol::Flag);
 
 // Manage memory for all symbols. BLOCK_SIZE symbols at a time are allocated.
 // Make() returns a reference to the next available one. They are never
if (const auto *details{detailsIf<UseDetails>()}) {
     return *this;
   }
 }
 
 inline DeclTypeSpec *Symbol::GetType() {
   return const_cast<DeclTypeSpec *>(
       const_cast<const Symbol *>(this)->GetType());
 }
-inline const DeclTypeSpec *Symbol::GetType() const {
+
+inline const DeclTypeSpec *Symbol::GetTypeImpl(int depth) const {
+  if (depth-- == 0) {
+    return nullptr;
+  }
   return common::visit(
       common::visitors{
           [](const EntityDetails &x) { return x.type(); },
           [](const ObjectEntityDetails &x) { return x.type(); },
           [](const AssocEntityDetails &x) { return x.type(); },
-          [](const SubprogramDetails &x) {
-            return x.isFunction() ? x.result().GetType() : nullptr;
+          [&](const SubprogramDetails &x) {
+            return x.isFunction() ? x.result().GetTypeImpl(depth) : nullptr;
           },
-          [](const ProcEntityDetails &x) {
+          [&](const ProcEntityDetails &x) {
             const Symbol *symbol{x.interface().symbol()};
-            return symbol ? symbol->GetType() : x.interface().type();
+            return symbol ? symbol->GetTypeImpl(depth) : x.interface().type();
+          },
+          [&](const ProcBindingDetails &x) {
+            return x.symbol().GetTypeImpl(depth);
           },
-          [](const ProcBindingDetails &x) { return x.symbol().GetType(); },
           [](const TypeParamDetails &x) { return x.type(); },
-          [](const UseDetails &x) { return x.symbol().GetType(); },
-          [](const HostAssocDetails &x) { return x.symbol().GetType(); },
+          [&](const UseDetails &x) { return x.symbol().GetTypeImpl(depth); },
+          [&](const HostAssocDetails &x) {
+            return x.symbol().GetTypeImpl(depth);
+          },
           [](const auto &) -> const DeclTypeSpec * { return nullptr; },
       },
       details_);
 }
 
+inline const DeclTypeSpec *Symbol::GetType() const { return GetTypeImpl(); }
+
 // Sets and maps keyed by Symbols
 
 struct SymbolAddressCompare {
   bool operator()(const SymbolRef &x, const SymbolRef &y) const {
     return &*x < &*y;
   }
   bool operator()(const MutableSymbolRef &x, const MutableSymbolRef &y) const {
     return &*x < &*y;

flang/lib/Evaluate/characteristics.cpp

 }
 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const semantics::Symbol &symbol, FoldingContext &context) {
   const auto &ultimate{symbol.GetUltimate()};
   return common::visit(
       common::visitors{
           [&](const semantics::ProcEntityDetails &proc) {
-            const semantics::ProcInterface &interface{proc.interface()};
+            const semantics::ProcInterface &interface { proc.interface() };
             if (interface.type()) {
               return Characterize(*interface.type(), context);
             } else if (interface.symbol()) {
               return Characterize(*interface.symbol(), context);
             } else {
               return std::optional<TypeAndShape>{};
             }
           },

 
 // These functions with arguments of type UnorderedSymbolSet 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::UnorderedSymbolSet seenProcs);
+static std::optional<FunctionResult> CharacterizeFunctionResult(
+    const semantics::Symbol &symbol, FoldingContext &context,
+    semantics::UnorderedSymbolSet seenProcs);
 
 static std::optional<Procedure> CharacterizeProcedure(
     const semantics::Symbol &original, FoldingContext &context,
     semantics::UnorderedSymbolSet seenProcs) {
   Procedure result;
   const auto &symbol{ResolveAssociations(original)};
   if (seenProcs.find(symbol) != seenProcs.end()) {
     std::string procsList{GetSeenProcs(seenProcs)};
if (IsPureProcedure(symbol) || // works for ENTRY too
           result.attrs.test(Procedure::Attr::Elemental))) {
     result.attrs.set(Procedure::Attr::Pure);
   }
   return common::visit(
       common::visitors{
           [&](const semantics::SubprogramDetails &subp)
               -> std::optional<Procedure> {
             if (subp.isFunction()) {
-              if (auto fr{
-                      FunctionResult::Characterize(subp.result(), context)}) {
+              if (auto fr{CharacterizeFunctionResult(
+                      subp.result(), context, seenProcs)}) {
                 result.functionResult = std::move(fr);
               } else {
                 return std::nullopt;
               }
             } else {
               result.attrs.set(Procedure::Attr::Subroutine);
             }
             for (const semantics::Symbol *arg : subp.dummyArgs()) {
return common::visit(
               // declaration checking in Semantics.
               auto intrinsic{context.intrinsics().IsSpecificIntrinsicFunction(
                   symbol.name().ToString())};
               if (intrinsic && intrinsic->isRestrictedSpecific) {
                 intrinsic.reset(); // Exclude intrinsics from table 16.3.
               }
               return intrinsic;
             }
-            const semantics::ProcInterface &interface{proc.interface()};
+            const semantics::ProcInterface &interface { proc.interface() };
             if (const semantics::Symbol * interfaceSymbol{interface.symbol()}) {
               return CharacterizeProcedure(
                   *interfaceSymbol, context, seenProcs);
             } else {
               result.attrs.set(Procedure::Attr::ImplicitInterface);
               const semantics::DeclTypeSpec *type{interface.type()};
               if (symbol.test(semantics::Symbol::Flag::Subroutine)) {
                 // ignore any implicit typing

 FunctionResult::FunctionResult(TypeAndShape &&t) : u{std::move(t)} {}
 FunctionResult::FunctionResult(Procedure &&p) : u{std::move(p)} {}
 FunctionResult::~FunctionResult() {}
 
 bool FunctionResult::operator==(const FunctionResult &that) const {
   return attrs == that.attrs && u == that.u;
 }
 
-std::optional<FunctionResult> FunctionResult::Characterize(
-    const Symbol &symbol, FoldingContext &context) {
+static std::optional<FunctionResult> CharacterizeFunctionResult(
+    const semantics::Symbol &symbol, FoldingContext &context,
+    semantics::UnorderedSymbolSet seenProcs) {
   if (symbol.has<semantics::ObjectEntityDetails>()) {
     if (auto type{TypeAndShape::Characterize(symbol, context)}) {
       FunctionResult result{std::move(*type)};
       CopyAttrs<FunctionResult, FunctionResult::Attr>(symbol, result,
           {
               {semantics::Attr::ALLOCATABLE, FunctionResult::Attr::Allocatable},
               {semantics::Attr::CONTIGUOUS, FunctionResult::Attr::Contiguous},
               {semantics::Attr::POINTER, FunctionResult::Attr::Pointer},
           });
       return result;
     }
-  } else if (auto maybeProc{Procedure::Characterize(symbol, context)}) {
+  } else if (auto maybeProc{
+                 CharacterizeProcedure(symbol, context, seenProcs)}) {
     FunctionResult result{std::move(*maybeProc)};
     result.attrs.set(FunctionResult::Attr::Pointer);
     return result;
   }
   return std::nullopt;
 }
 
+std::optional<FunctionResult> FunctionResult::Characterize(
+    const Symbol &symbol, FoldingContext &context) {
+  semantics::UnorderedSymbolSet seenProcs;
+  return CharacterizeFunctionResult(symbol, context, seenProcs);
+}
+
 bool FunctionResult::IsAssumedLengthCharacter() const {
   if (const auto *ts{std::get_if<TypeAndShape>(&u)}) {
     return ts->type().IsAssumedLengthCharacter();
   } else {
     return false;
   }
 }
 

flang/lib/Semantics/check-declarations.cpp

 
 // Check distinguishability of generic assignment and operators.
 // For these, generics and generic bindings must be considered together.
 void CheckHelper::CheckGenericOps(const Scope &scope) {
   DistinguishabilityHelper helper{context_};
   auto addSpecifics{[&](const Symbol &generic) {
     const auto *details{generic.GetUltimate().detailsIf<GenericDetails>()};
     if (!details) {
+      if (generic.test(Symbol::Flag::Function)) {
+        Characterize(generic);
+      }
       return;
     }
     GenericKind kind{details->kind()};
     if (!kind.IsAssignment() && !kind.IsOperator()) {
       return;
     }
     const SymbolVector &specifics{details->specificProcs()};
     const std::vector<SourceName> &bindingNames{details->bindingNames()};

flang/test/Semantics/resolve102.f90

subroutine circular
   call p(sub)
 
   contains
     subroutine sub(p2)
       procedure(p) :: p2
     end subroutine
 end subroutine circular
 
+!ERROR: Procedure 'foo' is recursively defined.  Procedures in the cycle: 'foo', 'r'
+function foo() result(r)
+  !ERROR: Procedure 'r' is recursively defined.  Procedures in the cycle: 'foo', 'r'
+  procedure(foo), pointer :: r 
+end function foo
+
 program iface
   !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