[flang] Use instantiated PDT for structure constructor in default init (#167409)

A structure constructor used in (or as) the default component
initializer for a PDT derived type component needs to traverse the scope
of the right PDT instantiation.

Fixes https://github.com/llvm/llvm-project/issues/167337 and fixes
https://github.com/llvm/llvm-project/issues/167573.

flang/include/flang/Semantics/type.h

@@ -301,6 +301,7 @@ public:
   void CookParameters(evaluate::FoldingContext &);
   // Evaluates type parameter expressions.
   void EvaluateParameters(SemanticsContext &);
+  void ReevaluateParameters(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

flang/lib/Semantics/expression.cpp

@@ -2103,17 +2103,32 @@ static MaybeExpr ImplicitConvertTo(const Symbol &sym, Expr<SomeType> &&expr,
 }
 
 MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
-    parser::CharBlock typeName, const semantics::DerivedTypeSpec &spec,
+    parser::CharBlock typeName, const semantics::DerivedTypeSpec &spec0,
     std::list<ComponentSpec> &&componentSpecs) {
+  semantics::Scope &scope{context_.FindScope(typeName)};
+  FoldingContext &foldingContext{GetFoldingContext()};
+  const semantics::DerivedTypeSpec *effectiveSpec{&spec0};
+  if (foldingContext.pdtInstance() && spec0.MightBeParameterized()) {
+    // We're processing a structure constructor in the context of a derived
+    // type instantiation, and the derived type of the structure constructor
+    // is parameterized.  Evaluate its parameters in the context of the
+    // instantiation in progress so that the components in constructor's scope
+    // have the correct types.
+    semantics::DerivedTypeSpec newSpec{spec0};
+    newSpec.ReevaluateParameters(context());
+    const semantics::DeclTypeSpec &instantiatedType{
+        semantics::FindOrInstantiateDerivedType(
+            scope, std::move(newSpec), semantics::DeclTypeSpec::TypeDerived)};
+    effectiveSpec = &instantiatedType.derivedTypeSpec();
+  }
+  const semantics::DerivedTypeSpec &spec{*effectiveSpec};
   const Symbol &typeSymbol{spec.typeSymbol()};
   if (!spec.scope() || !typeSymbol.has<semantics::DerivedTypeDetails>()) {
     return std::nullopt; // error recovery
   }
-  const semantics::Scope &scope{context_.FindScope(typeName)};
   const semantics::Scope *pureContext{FindPureProcedureContaining(scope)};
   const auto &typeDetails{typeSymbol.get<semantics::DerivedTypeDetails>()};
   const Symbol *parentComponent{typeDetails.GetParentComponent(*spec.scope())};
-
   if (typeSymbol.attrs().test(semantics::Attr::ABSTRACT)) { // C796
     AttachDeclaration(
         Say(typeName,
@@ -2153,6 +2168,9 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
     parser::CharBlock exprSource{componentSpec.exprSource};
     auto restorer{messages.SetLocation(source)};
     const Symbol *symbol{componentSpec.keywordSymbol};
+    if (symbol) {
+      symbol = spec.scope()->FindComponent(symbol->name());
+    }
     MaybeExpr &maybeValue{componentSpec.expr};
     if (!maybeValue.has_value()) {
       return std::nullopt;
@@ -2328,7 +2346,6 @@ MaybeExpr ExpressionAnalyzer::CheckStructureConstructor(
       // convert would cause a segfault. Lowering will deal with
       // conditionally converting and preserving the lower bounds in this
       // case.
-      FoldingContext &foldingContext{GetFoldingContext()};
       if (MaybeExpr converted{ImplicitConvertTo(*symbol, std::move(value),
               /*keepConvertImplicit=*/IsAllocatable(*symbol),
               foldingContext)}) {

flang/lib/Semantics/type.cpp

@@ -192,6 +192,13 @@ void DerivedTypeSpec::EvaluateParameters(SemanticsContext &context) {
   }
 }
 
+void DerivedTypeSpec::ReevaluateParameters(SemanticsContext &context) {
+  evaluated_ = false;
+  instantiated_ = false;
+  scope_ = nullptr;
+  EvaluateParameters(context);
+}
+
 void DerivedTypeSpec::AddParamValue(SourceName name, ParamValue &&value) {
   CHECK(cooked_);
   auto pair{parameters_.insert(std::make_pair(name, std::move(value)))};

flang/test/Semantics/structconst12.f90

@@ -1,12 +1,13 @@
 !RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
-!CHECK: TYPE(t) :: x = t(pp=f)
-!CHECK-NOT: error:
-interface
-  function f()
-  end
-end interface
-type t
-  procedure(f), nopass, pointer :: pp
+type t1(k1a,k1b)
+  integer, kind :: k1a, k1b
+  integer(k1a) :: j = -666
+  integer(k1b) :: c1 = k1a
 end type
-type(t) :: x = t(pp=f)
-end
+type t2(k2a,k2b)
+  integer, kind:: k2a, k2b
+  type(t1(k2a+1,k2b*2)) :: c2 = t1(k2a+1,k2b*2)(j=777)
+end type
+type (t2(3,4)), parameter :: x = t2(3,4)()
+!CHECK: TYPE(t2(3_4,4_4)), PARAMETER :: x = t2(k2a=3_4,k2b=4_4)(c2=t1(k1a=4_4,k1b=8_4)(j=777_4,c1=4_8))
+END