[flang] Enforce a limit on recursive PDT instantiations

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.

Differential Revision: https://reviews.llvm.org/D100065

7 files changed, 38 insertions, 24 deletions

diff --git a/flang/include/flang/Semantics/tools.h b/flang/include/flang/Semantics/tools.h
index 550cc99f85ef..ee368d9bcfe0 100644
--- a/flang/include/flang/Semantics/tools.h
+++ b/flang/include/flang/Semantics/tools.h
@@ -211,7 +211,7 @@ 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,
diff --git a/flang/include/flang/Semantics/type.h b/flang/include/flang/Semantics/type.h
index 8194b3861eba..6840f5b03517 100644
--- a/flang/include/flang/Semantics/type.h
+++ b/flang/include/flang/Semantics/type.h
@@ -268,7 +268,7 @@ public:
   // 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 {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 0b36de464129..b826221be643 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2217,8 +2217,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::FunctionReference &funcRef,
           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());
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index 304a7b9449d0..a62b7c36fe61 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -2237,7 +2237,7 @@ const DeclTypeSpec *ScopeHandler::GetImplicitType(
     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;
@@ -3931,7 +3931,7 @@ void DeclarationVisitor::Post(const parser::DerivedTypeSpec &x) {
     } else {
       auto restorer{
           GetFoldingContext().messages().SetLocation(currStmtSource().value())};
-      derived.Instantiate(currScope(), context());
+      derived.Instantiate(currScope());
     }
     SetDeclTypeSpec(type);
   }
@@ -6827,7 +6827,7 @@ void ResolveNamesVisitor::FinishSpecificationParts(const ProgramTree &node) {
 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() &&
diff --git a/flang/lib/Semantics/scope.cpp b/flang/lib/Semantics/scope.cpp
index 4faec3bd00cd..c6f73e583d6d 100644
--- a/flang/lib/Semantics/scope.cpp
+++ b/flang/lib/Semantics/scope.cpp
@@ -408,7 +408,7 @@ 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);
     }
   }
 }
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 256a5cc1d317..68db3e186a99 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1053,10 +1053,9 @@ SymbolVector OrderParameterDeclarations(const Symbol &typeSymbol) {
   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;
@@ -1064,7 +1063,7 @@ const DeclTypeSpec &FindOrInstantiateDerivedType(Scope &scope,
   // 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;
 }
 
diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp
index c548b5cbd199..40b434b7b86e 100644
--- a/flang/lib/Semantics/type.cpp
+++ b/flang/lib/Semantics/type.cpp
@@ -191,14 +191,14 @@ ParamValue *DerivedTypeSpec::FindParameter(SourceName 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));
@@ -209,16 +209,24 @@ private:
       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(),
@@ -236,7 +244,7 @@ void DerivedTypeSpec::Instantiate(
         if (DerivedTypeSpec * derived{type->AsDerived()}) {
           if (!(derived->IsForwardReferenced() &&
                   IsAllocatableOrPointer(symbol))) {
-            derived->Instantiate(containingScope, context);
+            derived->Instantiate(containingScope);
           }
         }
       }
@@ -253,6 +261,9 @@ void DerivedTypeSpec::Instantiate(
     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);
@@ -302,14 +313,19 @@ void DerivedTypeSpec::Instantiate(
   // 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) {
@@ -363,7 +379,7 @@ const DeclTypeSpec *InstantiateHelper::InstantiateType(const Symbol &symbol) {
   } 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) {
@@ -383,7 +399,7 @@ const DeclTypeSpec &InstantiateHelper::InstantiateIntrinsicType(
   // 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;