[flang] Enforce a limit on recursive PDT instantiations

[klausler]

Summary

For pernicious test cases with explicit non-constant actual
type parameter expressions in components, e.g.:

type :: t(k)
  integer, kind :: k
  type(t(k+1)), pointer :: p
end type

we should detect the infinite recursion and complain rather
than looping until the stack overflows.

[jeanPerier]

LGTM

flang/include/flang/Semantics/tools.h

 // definitions (parents first).
 SymbolVector OrderParameterDeclarations(const Symbol &);
 // Returns the complete list of derived type parameter names in the
 // order defined by 7.5.3.2.
 std::list<SourceName> OrderParameterNames(const Symbol &);
 
 // Return an existing or new derived type instance
 const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &, DerivedTypeSpec &&,
-    SemanticsContext &, DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
+    DeclTypeSpec::Category = DeclTypeSpec::TypeDerived);
 
 // When a subprogram defined in a submodule defines a separate module
 // procedure whose interface is defined in an ancestor (sub)module,
 // returns a pointer to that interface, else null.
 const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *);
 
 // Determines whether an object might be visible outside a
 // pure function (C1594); returns a non-null Symbol pointer for

flang/include/flang/Semantics/type.h

public:
   // Converts the raw parameter list to a map, naming each actual parameter.
   void CookParameters(evaluate::FoldingContext &);
   // Evaluates type parameter expressions.
   void EvaluateParameters(SemanticsContext &);
   void AddParamValue(SourceName, ParamValue &&);
   // Creates a Scope for the type and populates it with component
   // instantiations that have been specialized with actual type parameter
   // values, which are cooked &/or evaluated if necessary.
-  void Instantiate(Scope &, SemanticsContext &);
+  void Instantiate(Scope &containingScope);
 
   ParamValue *FindParameter(SourceName);
   const ParamValue *FindParameter(SourceName target) const {
     auto iter{parameters_.find(target)};
     if (iter != parameters_.end()) {
       return &iter->second;
     } else {
       return nullptr;

flang/lib/Semantics/expression.cpp

if (auto *proc{std::get_if<ProcedureDesignator>(&callee->u)}) {
         if (dtSpec.IsForwardReferenced()) {
           Say(call.source,
               "Cannot construct value for derived type '%s' "
               "before it is defined"_err_en_US,
               name->source);
           return std::nullopt;
         }
         const semantics::DeclTypeSpec &type{
-            semantics::FindOrInstantiateDerivedType(
-                scope, std::move(dtSpec), context_)};
+            semantics::FindOrInstantiateDerivedType(scope, std::move(dtSpec))};
         auto &mutableRef{const_cast<parser::FunctionReference &>(funcRef)};
         *structureConstructor =
             mutableRef.ConvertToStructureConstructor(type.derivedTypeSpec());
         return Analyze(structureConstructor->value());
       }
     }
   }
   return std::nullopt;

flang/lib/Semantics/resolve-names.cpp

const DeclTypeSpec *ScopeHandler::GetImplicitType(
   }
   scope = &GetInclusiveScope(*scope);
   const auto *type{implicitRulesMap_->at(scope).GetType(
       symbol.name(), respectImplicitNoneType)};
   if (type) {
     if (const DerivedTypeSpec * derived{type->AsDerived()}) {
       // Resolve any forward-referenced derived type; a quick no-op else.
       auto &instantiatable{*const_cast<DerivedTypeSpec *>(derived)};
-      instantiatable.Instantiate(currScope(), context());
+      instantiatable.Instantiate(currScope());
     }
   }
   return type;
 }
 
 // Convert symbol to be a ObjectEntity or return false if it can't be.
 bool ScopeHandler::ConvertToObjectEntity(Symbol &symbol) {
   if (symbol.has<ObjectEntityDetails>()) {
if (const DeclTypeSpec *
     DerivedTypeSpec &derived{type.derivedTypeSpec()};
     if (derived.MightBeParameterized() &&
         currScope().IsParameterizedDerivedType()) {
       // Defer instantiation; use the derived type's definition's scope.
       derived.set_scope(DEREF(spec->typeSymbol().scope()));
     } else {
       auto restorer{
           GetFoldingContext().messages().SetLocation(currStmtSource().value())};
-      derived.Instantiate(currScope(), context());
+      derived.Instantiate(currScope());
     }
     SetDeclTypeSpec(type);
   }
   // Capture the DerivedTypeSpec in the parse tree for use in building
   // structure constructor expressions.
   x.derivedTypeSpec = &GetDeclTypeSpec()->derivedTypeSpec();
 }
 

 }
 
 // Duplicate and fold component object pointer default initializer designators
 // using the actual type parameter values of each particular instantiation.
 // Validation is done later in declaration checking.
 void ResolveNamesVisitor::FinishDerivedTypeInstantiation(Scope &scope) {
   CHECK(scope.IsDerivedType() && !scope.symbol());
   if (DerivedTypeSpec * spec{scope.derivedTypeSpec()}) {
-    spec->Instantiate(currScope(), context());
+    spec->Instantiate(currScope());
     const Symbol &origTypeSymbol{spec->typeSymbol()};
     if (const Scope * origTypeScope{origTypeSymbol.scope()}) {
       CHECK(origTypeScope->IsDerivedType() &&
           origTypeScope->symbol() == &origTypeSymbol);
       auto &foldingContext{GetFoldingContext()};
       auto restorer{foldingContext.WithPDTInstance(*spec)};
       for (auto &pair : scope) {
         Symbol &comp{*pair.second};

flang/lib/Semantics/scope.cpp

const Scope &Scope::GetDerivedTypeBase() const {
   }
   return *child;
 }
 
 void Scope::InstantiateDerivedTypes() {
   for (DeclTypeSpec &type : declTypeSpecs_) {
     if (type.category() == DeclTypeSpec::TypeDerived ||
         type.category() == DeclTypeSpec::ClassDerived) {
-      type.derivedTypeSpec().Instantiate(*this, context_);
+      type.derivedTypeSpec().Instantiate(*this);
     }
   }
 }
 } // namespace Fortran::semantics

flang/lib/Semantics/tools.cpp

SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) {
   if (const DerivedTypeSpec * spec{typeSymbol.GetParentTypeSpec()}) {
     result = OrderParameterDeclarations(spec->typeSymbol());
   }
   const auto &paramDecls{typeSymbol.get<DerivedTypeDetails>().paramDecls()};
   result.insert(result.end(), paramDecls.begin(), paramDecls.end());
   return result;
 }
 
-const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
-    DerivedTypeSpec &&spec, SemanticsContext &semanticsContext,
-    DeclTypeSpec::Category category) {
-  spec.EvaluateParameters(semanticsContext);
+const DeclTypeSpec &FindOrInstantiateDerivedType(
+    Scope &scope, DerivedTypeSpec &&spec, DeclTypeSpec::Category category) {
+  spec.EvaluateParameters(scope.context());
   if (const DeclTypeSpec *
       type{scope.FindInstantiatedDerivedType(spec, category)}) {
     return *type;
   }
   // Create a new instantiation of this parameterized derived type
   // for this particular distinct set of actual parameter values.
   DeclTypeSpec &type{scope.MakeDerivedType(category, std::move(spec))};
-  type.derivedTypeSpec().Instantiate(scope, semanticsContext);
+  type.derivedTypeSpec().Instantiate(scope);
   return type;
 }
 
 const Symbol *FindSeparateModuleSubprogramInterface(const Symbol *proc) {
   if (proc) {
     if (const Symbol * submodule{proc->owner().symbol()}) {
       if (const auto *details{submodule->detailsIf<ModuleDetails>()}) {
         if (const Scope * ancestor{details->ancestor()}) {

flang/lib/Semantics/type.cpp

 
 ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
   return const_cast<ParamValue *>(
       const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
 }
 
 class InstantiateHelper {
 public:
-  InstantiateHelper(SemanticsContext &context, Scope &scope)
-      : context_{context}, scope_{scope} {}
+  InstantiateHelper(Scope &scope) : scope_{scope} {}
   // Instantiate components from fromScope into scope_
   void InstantiateComponents(const Scope &);
 
 private:
+  SemanticsContext &context() const { return scope_.context(); }
   evaluate::FoldingContext &foldingContext() {
-    return context_.foldingContext();
+    return context().foldingContext();
   }
   template <typename T> T Fold(T &&expr) {
     return evaluate::Fold(foldingContext(), std::move(expr));
   }
   void InstantiateComponent(const Symbol &);
   const DeclTypeSpec *InstantiateType(const Symbol &);
   const DeclTypeSpec &InstantiateIntrinsicType(
       SourceName, const DeclTypeSpec &);
   DerivedTypeSpec CreateDerivedTypeSpec(const DerivedTypeSpec &, bool);
 
-  SemanticsContext &context_;
   Scope &scope_;
 };
 
-void DerivedTypeSpec::Instantiate(
-    Scope &containingScope, SemanticsContext &context) {
+static int PlumbPDTInstantiationDepth(const Scope *scope) {
+  int depth{0};
+  while (scope->IsParameterizedDerivedTypeInstantiation()) {
+    ++depth;
+    scope = &scope->parent();
+  }
+  return depth;
+}
+
+void DerivedTypeSpec::Instantiate(Scope &containingScope) {
   if (instantiated_) {
     return;
   }
   instantiated_ = true;
+  auto &context{containingScope.context()};
   auto &foldingContext{context.foldingContext()};
   if (IsForwardReferenced()) {
     foldingContext.messages().Say(typeSymbol_.name(),
         "The derived type '%s' was forward-referenced but not defined"_err_en_US,
         typeSymbol_.name());
     return;
   }
   EvaluateParameters(context);
   const Scope &typeScope{DEREF(typeSymbol_.scope())};
   if (!MightBeParameterized()) {
     scope_ = &typeScope;
     for (auto &pair : typeScope) {
       Symbol &symbol{*pair.second};
       if (DeclTypeSpec * type{symbol.GetType()}) {
         if (DerivedTypeSpec * derived{type->AsDerived()}) {
           if (!(derived->IsForwardReferenced() &&
                   IsAllocatableOrPointer(symbol))) {
-            derived->Instantiate(containingScope, context);
+            derived->Instantiate(containingScope);
           }
         }
       }
       if (!IsPointer(symbol)) {
         if (auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
           if (MaybeExpr & init{object->init()}) {
             auto restorer{foldingContext.messages().SetLocation(symbol.name())};
             init = evaluate::NonPointerInitializationExpr(
                 symbol, std::move(*init), foldingContext);
           }
         }
       }
     }
     ComputeOffsets(context, const_cast<Scope &>(typeScope));
     return;
   }
+  // New PDT instantiation.  Create a new scope and populate it
+  // with components that have been specialized for this set of
+  // parameters.
   Scope &newScope{containingScope.MakeScope(Scope::Kind::DerivedType)};
   newScope.set_derivedTypeSpec(*this);
   ReplaceScope(newScope);
   auto restorer{foldingContext.WithPDTInstance(*this)};
   std::string desc{typeSymbol_.name().ToString()};
   char sep{'('};
   for (const Symbol &symbol : OrderParameterDeclarations(typeSymbol_)) {
     const SourceName &name{symbol.name()};
if (auto outer{containingScope.instantiationContext()}) {
       contextMessage->SetContext(outer.get());
     }
     newScope.set_instantiationContext(contextMessage);
   }
   // Instantiate every non-parameter symbol from the original derived
   // type's scope into the new instance.
   newScope.AddSourceRange(typeScope.sourceRange());
   auto restorer2{foldingContext.messages().SetContext(contextMessage)};
-  InstantiateHelper{context, newScope}.InstantiateComponents(typeScope);
+  if (PlumbPDTInstantiationDepth(&containingScope) > 100) {
+    foldingContext.messages().Say(
+        "Too many recursive parameterized derived type instantiations"_err_en_US);
+  } else {
+    InstantiateHelper{newScope}.InstantiateComponents(typeScope);
+  }
 }
 
 void InstantiateHelper::InstantiateComponents(const Scope &fromScope) {
   for (const auto &pair : fromScope) {
     InstantiateComponent(*pair.second);
   }
-  ComputeOffsets(context_, scope_);
+  ComputeOffsets(context(), scope_);
 }
 
 void InstantiateHelper::InstantiateComponent(const Symbol &oldSymbol) {
   auto pair{scope_.try_emplace(
       oldSymbol.name(), oldSymbol.attrs(), common::Clone(oldSymbol.details()))};
   Symbol &newSymbol{*pair.first->second};
   if (!pair.second) {
     // Symbol was already present in the scope, which can only happen

 
 const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
   const DeclTypeSpec *type{symbol.GetType()};
   if (!type) {
     return nullptr; // error has occurred
   } else if (const DerivedTypeSpec * spec{type->AsDerived()}) {
     return &FindOrInstantiateDerivedType(scope_,
         CreateDerivedTypeSpec(*spec, symbol.test(Symbol::Flag::ParentComp)),
-        context_, type->category());
+        type->category());
   } else if (type->AsIntrinsic()) {
     return &InstantiateIntrinsicType(symbol.name(), *type);
   } else if (type->category() == DeclTypeSpec::ClassStar) {
     return type;
   } else {
     common::die("InstantiateType: %s", type->AsFortran().c_str());
   }
 }
 
 // Apply type parameter values to an intrinsic type spec.
 const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
     SourceName symbolName, const DeclTypeSpec &spec) {
   const IntrinsicTypeSpec &intrinsic{DEREF(spec.AsIntrinsic())};
   if (evaluate::ToInt64(intrinsic.kind())) {
     return spec; // KIND is already a known constant
   }
   // The expression was not originally constant, but now it must be so
   // in the context of a parameterized derived type instantiation.
   KindExpr copy{Fold(common::Clone(intrinsic.kind()))};
-  int kind{context_.GetDefaultKind(intrinsic.category())};
+  int kind{context().GetDefaultKind(intrinsic.category())};
   if (auto value{evaluate::ToInt64(copy)}) {
     if (evaluate::IsValidKindOfIntrinsicType(intrinsic.category(), *value)) {
       kind = *value;
     } else {
       foldingContext().messages().Say(symbolName,
           "KIND parameter value (%jd) of intrinsic type %s "
           "did not resolve to a supported value"_err_en_US,
           *value,