[flang] Run-time derived type initialization and destruction

[klausler]

Summary

Use derived type information tables to drive default component
initialization (when needed), component destruction, and calls to
final subroutines. Perform these operations automatically for
ALLOCATE()/DEALLOCATE() APIs for allocatables, automatics, and
pointers. Add APIs for use in lowering to perform these operations
for non-allocatable/automatic non-pointer variables.
Data pointer component initialization supports arbitrary constant
designators, a F'2008 feature, which may be a first for Fortran
implementations.

[jeanPerier]

Looks great

flang/docs/Extensions.md

 ## Standard features not silently accepted
 
 * Fortran explicitly ignores type declaration statements when they
   attempt to type the name of a generic intrinsic function (8.2 p3).
   One can declare `CHARACTER::COS` and still get a real result
   from `COS(3.14159)`, for example.  f18 will complain when a
   generic intrinsic function's inferred result type does not
   match an explicit declaration.  This message is a warning.
+
+## Standard features that might as well not be
+
+* f18 supports designators with constant expressions, properly
+  constrained, as initial data targets for data pointers in
+  initializers of variable and component declarations and in
+  `DATA` statements; e.g., `REAL, POINTER :: P => T(1:10:2)`.
+  This Fortran 2008 feature might as well be viewed like an
+  extension; no other compiler that we've tested can handle
+  it yet.

flang/include/flang/Semantics/tools.h

 // =>target in its declaration, or optionally in a DATA statement? (Being
 // ALLOCATABLE or having a derived type with default component initialization
 // doesn't count; it must be a variable initialization that implies the SAVE
 // attribute, or a derived type component default value.)
 bool IsStaticallyInitialized(const Symbol &, bool ignoreDATAstatements = false);
 // Is the symbol explicitly or implicitly initialized in any way?
 bool IsInitialized(const Symbol &, bool ignoreDATAstatements = false,
     const Symbol *derivedType = nullptr);
+// Is the symbol a component subject to deallocation or finalization?
+bool IsDestructible(const Symbol &, const Symbol *derivedType = nullptr);
 bool HasIntrinsicTypeName(const Symbol &);
 bool IsSeparateModuleProcedureInterface(const Symbol *);
 bool IsAutomatic(const Symbol &);
 bool HasAlternateReturns(const Symbol &);
 bool InCommonBlock(const Symbol &);
 
 // Return an ultimate component of type that matches predicate, or nullptr.
 const Symbol *FindUltimateComponent(const DerivedTypeSpec &type,

flang/include/flang/Semantics/type.h

public:
   void set_scope(const Scope &);
   void ReplaceScope(const Scope &);
   RawParameters &rawParameters() { return rawParameters_; }
   const ParameterMapType &parameters() const { return parameters_; }
 
   bool MightBeParameterized() const;
   bool IsForwardReferenced() const;
   bool HasDefaultInitialization() const;
+  bool HasDestruction() const;
 
   // The "raw" type parameter list is a simple transcription from the
   // parameter list in the parse tree, built by calling AddRawParamValue().
   // It can be used with forward-referenced derived types.
   void AddRawParamValue(const std::optional<parser::Keyword> &, ParamValue &&);
   // Checks the raw parameter list against the definition of a derived type.
   // Converts the raw parameter list to a map, naming each actual parameter.
   void CookParameters(evaluate::FoldingContext &);

flang/lib/Evaluate/shape.cpp

struct MyVisitor : public AnyTraverse<MyVisitor> {
     using Base::operator();
     bool operator()(const ImpliedDoIndex &) { return true; }
   };
   return MyVisitor{}(expr);
 }
 
 // Determines lower bound on a dimension.  This can be other than 1 only
 // for a reference to a whole array object or component. (See LBOUND, 16.9.109).
-// ASSOCIATE construct entities may require tranversal of their referents.
+// ASSOCIATE construct entities may require traversal of their referents.
 class GetLowerBoundHelper : public Traverse<GetLowerBoundHelper, ExtentExpr> {
 public:
   using Result = ExtentExpr;
   using Base = Traverse<GetLowerBoundHelper, ExtentExpr>;
   using Base::operator();
   explicit GetLowerBoundHelper(int d) : Base{*this}, dimension_{d} {}
   static ExtentExpr Default() { return ExtentExpr{1}; }
   static ExtentExpr Combine(Result &&, Result &&) { return Default(); }

flang/lib/Evaluate/tools.cpp

 bool IsSaved(const Symbol &original) {
   const Symbol &symbol{GetAssociationRoot(original)};
   const Scope &scope{symbol.owner()};
   auto scopeKind{scope.kind()};
   if (symbol.has<AssocEntityDetails>()) {
     return false; // ASSOCIATE(non-variable)
   } else if (scopeKind == Scope::Kind::Module) {
     return true; // BLOCK DATA entities must all be in COMMON, handled below
-  } else if (symbol.attrs().test(Attr::SAVE)) {
-    return true;
   } else if (scopeKind == Scope::Kind::DerivedType) {
     return false; // this is a component
+  } else if (symbol.attrs().test(Attr::SAVE)) {
+    return true;
+  } else if (symbol.test(Symbol::Flag::InDataStmt)) {
+    return true;
   } else if (IsNamedConstant(symbol)) {
     return false;
   } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()};
              object && object->init()) {
     return true;
   } else if (IsProcedurePointer(symbol) &&
       symbol.get<ProcEntityDetails>().init()) {
     return true;

flang/lib/Semantics/check-declarations.cpp

if (symbol.attrs().test(Attr::CONTIGUOUS) && IsPointer(symbol) &&
       symbol.Rank() == 0) { // C830
     messages_.Say("CONTIGUOUS POINTER must be an array"_err_en_US);
   }
   if (IsDummy(symbol)) {
     if (IsNamedConstant(symbol)) {
       messages_.Say(
           "A dummy argument may not also be a named constant"_err_en_US);
     }
-    if (IsSaved(symbol)) {
+    if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
+        IsSaved(symbol)) {
       messages_.Say(
           "A dummy argument may not have the SAVE attribute"_err_en_US);
     }
   } else if (IsFunctionResult(symbol)) {
-    if (IsSaved(symbol)) {
+    if (!symbol.test(Symbol::Flag::InDataStmt) /*caught elsewhere*/ &&
+        IsSaved(symbol)) {
       messages_.Say(
           "A function result may not have the SAVE attribute"_err_en_US);
     }
   }
   if (symbol.owner().IsDerivedType() &&
       (symbol.attrs().test(Attr::CONTIGUOUS) &&
           !(IsPointer(symbol) && symbol.Rank() > 0))) { // C752
     messages_.Say(

flang/lib/Semantics/compute-offsets.cpp

 
 auto ComputeOffsetsHelper::GetSizeAndAlignment(
     const Symbol &symbol, bool entire) -> SizeAndAlignment {
   // TODO: The size of procedure pointers is not yet known
   // and is independent of rank (and probably also the number
   // of length type parameters).
   auto &foldingContext{context_.foldingContext()};
   if (IsDescriptor(symbol) || IsProcedurePointer(symbol)) {
-    int lenParams{0};
-    if (const auto *derived{evaluate::GetDerivedTypeSpec(
-            evaluate::DynamicType::From(symbol))}) {
-      lenParams = CountLenParameters(*derived);
-    }
-    std::size_t size{
-        runtime::Descriptor::SizeInBytes(symbol.Rank(), false, lenParams)};
+    const auto *derived{
+        evaluate::GetDerivedTypeSpec(evaluate::DynamicType::From(symbol))};
+    int lenParams{derived ? CountLenParameters(*derived) : 0};
+    std::size_t size{runtime::Descriptor::SizeInBytes(
+        symbol.Rank(), derived != nullptr, lenParams)};
     return {size, foldingContext.maxAlignment()};
   }
   if (IsProcedure(symbol)) {
     return {};
   }
   if (auto chars{evaluate::characteristics::TypeAndShape::Characterize(
           symbol, foldingContext)}) {
     if (entire) {

flang/lib/Semantics/resolve-names.cpp

if (const DeclTypeSpec *
     SetDeclTypeSpec(*extant);
   } else {
     DeclTypeSpec &type{currScope().MakeDerivedType(category, std::move(*spec))};
     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 if (&currScope() == spec->typeSymbol().scope()) {
+      // Direct recursive use of a type in the definition of one of its
+      // components: defer instantiation
     } else {
       auto restorer{
           GetFoldingContext().messages().SetLocation(currStmtSource().value())};
       derived.Instantiate(currScope());
     }
     SetDeclTypeSpec(type);
   }
   // Capture the DerivedTypeSpec in the parse tree for use in building

flang/lib/Semantics/runtime-type-info.cpp

static int FindLenParameterIndex(
   }
   DIE("Length type parameter not found in parameter order");
   return -1;
 }
 
 class RuntimeTableBuilder {
 public:
   RuntimeTableBuilder(SemanticsContext &, RuntimeDerivedTypeTables &);
-  void DescribeTypes(Scope &scope);
+  void DescribeTypes(Scope &scope, bool inSchemata);
 
 private:
   const Symbol *DescribeType(Scope &);
   const Symbol &GetSchemaSymbol(const char *) const;
   const DeclTypeSpec &GetSchema(const char *) const;
   SomeExpr GetEnumValue(const char *) const;
   Symbol &CreateObject(const std::string &, const DeclTypeSpec &, Scope &);
   // The names of created symbols are saved in and owned by the
   // RuntimeDerivedTypeTables instance returned by
   // BuildRuntimeDerivedTypeTables() so that references to those names remain
   // valid for lowering.
   SourceName SaveObjectName(const std::string &);
   SomeExpr SaveNameAsPointerTarget(Scope &, const std::string &);
   const SymbolVector *GetTypeParameters(const Symbol &);
   evaluate::StructureConstructor DescribeComponent(const Symbol &,
       const ObjectEntityDetails &, Scope &, Scope &,
       const std::string &distinctName, const SymbolVector *parameters);
   evaluate::StructureConstructor DescribeComponent(
       const Symbol &, const ProcEntityDetails &, Scope &);
+  bool InitializeDataPointer(evaluate::StructureConstructorValues &,
+      const Symbol &symbol, const ObjectEntityDetails &object, Scope &scope,
+      Scope &dtScope, const std::string &distinctName);
   evaluate::StructureConstructor PackageIntValue(
       const SomeExpr &genre, std::int64_t = 0) const;
   SomeExpr PackageIntValueExpr(const SomeExpr &genre, std::int64_t = 0) const;
   std::vector<const Symbol *> CollectBindings(const Scope &dtScope) const;
   std::vector<evaluate::StructureConstructor> DescribeBindings(
       const Scope &dtScope, Scope &);
   void DescribeGeneric(
       const GenericDetails &, std::vector<evaluate::StructureConstructor> &);
private:
   SomeExpr finalEnum_; // SpecialBinding::Which::Final
   SomeExpr elementalFinalEnum_; // SpecialBinding::Which::ElementalFinal
   SomeExpr assumedRankFinalEnum_; // SpecialBinding::Which::AssumedRankFinal
   SomeExpr readFormattedEnum_; // SpecialBinding::Which::ReadFormatted
   SomeExpr readUnformattedEnum_; // SpecialBinding::Which::ReadUnformatted
   SomeExpr writeFormattedEnum_; // SpecialBinding::Which::WriteFormatted
   SomeExpr writeUnformattedEnum_; // SpecialBinding::Which::WriteUnformatted
   parser::CharBlock location_;
+  std::set<const Scope *> ignoreScopes_;
 };
 
 RuntimeTableBuilder::RuntimeTableBuilder(
     SemanticsContext &c, RuntimeDerivedTypeTables &t)
     : context_{c}, tables_{t}, derivedTypeSchema_{GetSchema("derivedtype")},
       componentSchema_{GetSchema("component")}, procPtrSchema_{GetSchema(
                                                     "procptrcomponent")},
       valueSchema_{GetSchema("value")}, bindingSchema_{GetSchema("binding")},
       specialSchema_{GetSchema("specialbinding")}, deferredEnum_{GetEnumValue(
                                                        "deferred")},
       explicitEnum_{GetEnumValue("explicit")}, lenParameterEnum_{GetEnumValue(
                                                    "lenparameter")},
       assignmentEnum_{GetEnumValue("assignment")},
       elementalAssignmentEnum_{GetEnumValue("elementalassignment")},
       finalEnum_{GetEnumValue("final")}, elementalFinalEnum_{GetEnumValue(
                                              "elementalfinal")},
       assumedRankFinalEnum_{GetEnumValue("assumedrankfinal")},
       readFormattedEnum_{GetEnumValue("readformatted")},
       readUnformattedEnum_{GetEnumValue("readunformatted")},
       writeFormattedEnum_{GetEnumValue("writeformatted")},
-      writeUnformattedEnum_{GetEnumValue("writeunformatted")} {}
-
-void RuntimeTableBuilder::DescribeTypes(Scope &scope) {
-  if (&scope == tables_.schemata) {
-    return; // don't loop trying to describe a schema...
-  }
+      writeUnformattedEnum_{GetEnumValue("writeunformatted")} {
+  ignoreScopes_.insert(tables_.schemata);
+
+void RuntimeTableBuilder::DescribeTypes(Scope &scope, bool inSchemata) {
+  inSchemata |= ignoreScopes_.find(&scope) != ignoreScopes_.end();
   if (scope.IsDerivedType()) {
+    if (!inSchemata) { // don't loop trying to describe a schema
       DescribeType(scope);
+    }
   } else {
-    for (Scope &child : scope.children()) {
-      DescribeTypes(child);
-    }
+    scope.InstantiateDerivedTypes();
+  for (Scope &child : scope.children()) {
+    DescribeTypes(child, inSchemata);
   }
 }
 
 // Returns derived type instantiation's parameters in declaration order
 const SymbolVector *RuntimeTableBuilder::GetTypeParameters(
     const Symbol &symbol) {
   auto iter{orderedTypeParameters_.find(&symbol)};
   if (iter != orderedTypeParameters_.end()) {
const Symbol &symbol{*scope
                             .try_emplace(name, Attrs{Attr::TARGET, Attr::SAVE},
                                 ObjectEntityDetails{object})
                             .first->second};
   CHECK(symbol.get<ObjectEntityDetails>().init().has_value());
   return evaluate::AsGenericExpr(
       evaluate::Designator<evaluate::SomeDerived>{symbol});
 }
 
+template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
+  return evaluate::AsGenericExpr(
+      evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
+}
+
 const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
   if (const Symbol * info{dtScope.runtimeDerivedTypeDescription()}) {
     return info;
   }
   const DerivedTypeSpec *derivedTypeSpec{dtScope.derivedTypeSpec()};
+  if (!derivedTypeSpec && !dtScope.IsParameterizedDerivedType() &&
+      dtScope.symbol()) {
+    // This derived type was declared (obviously, there's a Scope) but never
+    // used in this compilation (no instantiated DerivedTypeSpec points here).
+    // Create a DerivedTypeSpec now for it so that ComponentIterator
+    // will work. This covers the case of a derived type that's declared in
+    // a module but used only by clients and submodules, enabling the
+    // run-time "no initialization needed here" flag to work.
+    DerivedTypeSpec derived{dtScope.symbol()->name(), *dtScope.symbol()};
+    DeclTypeSpec &decl{
+        dtScope.MakeDerivedType(DeclTypeSpec::TypeDerived, std::move(derived))};
+    derivedTypeSpec = &decl.derivedTypeSpec();
+  }
   const Symbol *dtSymbol{
       derivedTypeSpec ? &derivedTypeSpec->typeSymbol() : dtScope.symbol()};
   if (!dtSymbol) {
     return nullptr;
   }
   auto locationRestorer{common::ScopedSet(location_, dtSymbol->name())};
   // Check for an existing description that can be imported from a USE'd module
   std::string typeName{dtSymbol->name().ToString()};
if (!isPDTdefinition) {
     if (auto alignment{dtScope.alignment().value_or(0)}) {
       sizeInBytes += alignment - 1;
       sizeInBytes /= alignment;
       sizeInBytes *= alignment;
     }
     AddValue(
         dtValues, derivedTypeSchema_, "sizeinbytes"s, IntToExpr(sizeInBytes));
   }
-  const Symbol *parentDescObject{nullptr};
-  if (const Scope * parentScope{dtScope.GetDerivedTypeParent()}) {
-    parentDescObject = DescribeType(*const_cast<Scope *>(parentScope));
-  }
-  if (parentDescObject) {
-    AddValue(dtValues, derivedTypeSchema_, "parent"s,
-        evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
-            evaluate::Designator<evaluate::SomeDerived>{*parentDescObject}}));
-  } else {
-    AddValue(dtValues, derivedTypeSchema_, "parent"s,
-        SomeExpr{evaluate::NullPointer{}});
-  }
   bool isPDTinstantiation{derivedTypeSpec && &dtScope != dtSymbol->scope()};
   if (isPDTinstantiation) {
     // is PDT instantiation
     const Symbol *uninstDescObject{
         DescribeType(DEREF(const_cast<Scope *>(dtSymbol->scope())))};
     AddValue(dtValues, derivedTypeSchema_, "uninstantiated"s,
         evaluate::AsGenericExpr(evaluate::Expr<evaluate::SomeDerived>{
             evaluate::Designator<evaluate::SomeDerived>{
if (!isPDTdefinition) {
     IncorporateDefinedIoGenericInterfaces(specials,
         SourceName{"write(unformatted)", 18},
         GenericKind::DefinedIo::WriteUnformatted, &scope);
     AddValue(dtValues, derivedTypeSchema_, "special"s,
         SaveDerivedPointerTarget(scope, SaveObjectName(".s."s + distinctName),
             std::move(specials),
             evaluate::ConstantSubscripts{
                 static_cast<evaluate::ConstantSubscript>(specials.size())}));
+    // Note the presence/absence of a parent component
+    AddValue(dtValues, derivedTypeSchema_, "hasparent"s,
+        IntExpr<1>(dtScope.GetDerivedTypeParent() != nullptr));
+    // To avoid wasting run time attempting to initialize derived type
+    // instances without any initialized components, analyze the type
+    // and set a flag if there's nothing to do for it at run time.
+    AddValue(dtValues, derivedTypeSchema_, "noinitializationneeded"s,
+        IntExpr<1>(
+            derivedTypeSpec && !derivedTypeSpec->HasDefaultInitialization()));
+    // Similarly, a flag to short-circuit destruction when not needed.
+    AddValue(dtValues, derivedTypeSchema_, "nodestructionneeded"s,
+        IntExpr<1>(derivedTypeSpec && !derivedTypeSpec->HasDestruction()));
   }
   dtObject.get<ObjectEntityDetails>().set_init(MaybeExpr{
       StructureExpr(Structure(derivedTypeSchema_, std::move(dtValues)))});
   return &dtObject;
 }
 
 static const Symbol &GetSymbol(const Scope &schemata, SourceName name) {
   auto iter{schemata.find(name)};
const DeclTypeSpec &RuntimeTableBuilder::GetSchema(
   if (!spec) {
     spec = &schemata.MakeDerivedType(
         DeclTypeSpec::TypeDerived, DerivedTypeSpec{name, symbol});
   }
   CHECK(spec->AsDerived());
   return *spec;
 }
 
-template <int KIND> static SomeExpr IntExpr(std::int64_t n) {
-  return evaluate::AsGenericExpr(
-      evaluate::Constant<evaluate::Type<TypeCategory::Integer, KIND>>{n});
-}
-
 SomeExpr RuntimeTableBuilder::GetEnumValue(const char *name) const {
   const Symbol &symbol{GetSchemaSymbol(name)};
   auto value{evaluate::ToInt64(symbol.get<ObjectEntityDetails>().init())};
   CHECK(value.has_value());
   return IntExpr<1>(*value);
 }
 
 Symbol &RuntimeTableBuilder::CreateObject(
AddValue(
         values, componentSchema_, "bounds"s, SomeExpr{evaluate::NullPointer{}});
   }
   // Default component initialization
   bool hasDataInit{false};
   if (IsAllocatable(symbol)) {
     AddValue(values, componentSchema_, "genre"s, GetEnumValue("allocatable"));
   } else if (IsPointer(symbol)) {
     AddValue(values, componentSchema_, "genre"s, GetEnumValue("pointer"));
-    hasDataInit = object.init().has_value();
-    if (hasDataInit) {
-      AddValue(values, componentSchema_, "initialization"s,
-          SomeExpr{*object.init()});
-    }
+    hasDataInit = InitializeDataPointer(
+        values, symbol, object, scope, dtScope, distinctName);
   } else if (IsAutomaticObject(symbol)) {
     AddValue(values, componentSchema_, "genre"s, GetEnumValue("automatic"));
   } else {
     AddValue(values, componentSchema_, "genre"s, GetEnumValue("data"));
     hasDataInit = object.init().has_value();
     if (hasDataInit) {
       AddValue(values, componentSchema_, "initialization"s,
           SaveObjectInit(scope,
AddValue(values, procPtrSchema_, "initialization"s,
         SomeExpr{evaluate::ProcedureDesignator{**init}});
   } else {
     AddValue(values, procPtrSchema_, "initialization"s,
         SomeExpr{evaluate::NullPointer{}});
   }
   return {DEREF(procPtrSchema_.AsDerived()), std::move(values)};
 }
 
+// Create a static pointer object with the same initialization
+// from whence the runtime can memcpy() the data pointer
+// component initialization.
+// Creates and interconnects the symbols, scopes, and types for
+//   TYPE :: ptrDt
+//     type, POINTER :: name
+//   END TYPE
+//   TYPE(ptrDt), TARGET, SAVE :: ptrInit = ptrDt(designator)
+// and then initializes the original component by setting
+//   initialization = ptrInit
+// which takes the address of ptrInit because the type is C_PTR.
+// This technique of wrapping the data pointer component into
+// a derived type instance disables any reason for lowering to
+// attempt to dereference the RHS of an initializer, thereby
+// allowing the runtime to actually perform the initialization
+// by means of a simple memcpy() of the wrapped descriptor in
+// ptrInit to the data pointer component being initialized.
+bool RuntimeTableBuilder::InitializeDataPointer(
+    evaluate::StructureConstructorValues &values, const Symbol &symbol,
+    const ObjectEntityDetails &object, Scope &scope, Scope &dtScope,
+    const std::string &distinctName) {
+  if (object.init().has_value()) {
+    SourceName ptrDtName{SaveObjectName(
+        ".dp."s + distinctName + "."s + symbol.name().ToString())};
+    Symbol &ptrDtSym{
+        *scope.try_emplace(ptrDtName, Attrs{}, UnknownDetails{}).first->second};
+    Scope &ptrDtScope{scope.MakeScope(Scope::Kind::DerivedType, &ptrDtSym)};
+    ignoreScopes_.insert(&ptrDtScope);
+    ObjectEntityDetails ptrDtObj;
+    ptrDtObj.set_type(DEREF(object.type()));
+    ptrDtObj.set_shape(object.shape());
+    Symbol &ptrDtComp{*ptrDtScope
+                           .try_emplace(symbol.name(), Attrs{Attr::POINTER},
+                               std::move(ptrDtObj))
+                           .first->second};
+    DerivedTypeDetails ptrDtDetails;
+    ptrDtDetails.add_component(ptrDtComp);
+    ptrDtSym.set_details(std::move(ptrDtDetails));
+    ptrDtSym.set_scope(&ptrDtScope);
+    DeclTypeSpec &ptrDtDeclType{
+        scope.MakeDerivedType(DeclTypeSpec::Category::TypeDerived,
+            DerivedTypeSpec{ptrDtName, ptrDtSym})};
+    DerivedTypeSpec &ptrDtDerived{DEREF(ptrDtDeclType.AsDerived())};
+    ptrDtDerived.set_scope(ptrDtScope);
+    ptrDtDerived.CookParameters(context_.foldingContext());
+    ptrDtDerived.Instantiate(scope);
+    ObjectEntityDetails ptrInitObj;
+    ptrInitObj.set_type(ptrDtDeclType);
+    evaluate::StructureConstructorValues ptrInitValues;
+    AddValue(
+        ptrInitValues, ptrDtDeclType, symbol.name().ToString(), *object.init());
+    ptrInitObj.set_init(evaluate::AsGenericExpr(
+        Structure(ptrDtDeclType, std::move(ptrInitValues))));
+    AddValue(values, componentSchema_, "initialization"s,
+        SaveObjectInit(scope,
+            SaveObjectName(
+                ".di."s + distinctName + "."s + symbol.name().ToString()),
+            ptrInitObj));
+    return true;
+  } else {
+    return false;
+  }
+}
+
 evaluate::StructureConstructor RuntimeTableBuilder::PackageIntValue(
     const SomeExpr &genre, std::int64_t n) const {
   evaluate::StructureConstructorValues xs;
   AddValue(xs, valueSchema_, "genre"s, genre);
   AddValue(xs, valueSchema_, "value"s, IntToExpr(n));
   return Structure(valueSchema_, std::move(xs));
 }
 
RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(
     SemanticsContext &context) {
   ModFileReader reader{context};
   RuntimeDerivedTypeTables result;
   static const char schemataName[]{"__fortran_type_info"};
   SourceName schemataModule{schemataName, std::strlen(schemataName)};
   result.schemata = reader.Read(schemataModule);
   if (result.schemata) {
     RuntimeTableBuilder builder{context, result};
-    builder.DescribeTypes(context.globalScope());
+    builder.DescribeTypes(context.globalScope(), false);
   }
   return result;
 }
 } // namespace Fortran::semantics

flang/lib/Semantics/tools.cpp

if (!object->isDummy() && object->type()) {
       // recursive usage of a derived type
       return derived && &derived->typeSymbol() != derivedTypeSymbol &&
           derived->HasDefaultInitialization();
     }
   }
   return false;
 }
 
+bool IsDestructible(const Symbol &symbol, const Symbol *derivedTypeSymbol) {
+  if (IsAllocatable(symbol) || IsAutomatic(symbol)) {
+    return true;
+  } else if (IsNamedConstant(symbol) || IsFunctionResult(symbol) ||
+      IsPointer(symbol)) {
+    return false;
+  } else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
+    if (!object->isDummy() && object->type()) {
+      if (const auto *derived{object->type()->AsDerived()}) {
+        return &derived->typeSymbol() != derivedTypeSymbol &&
+            derived->HasDestruction();
+      }
+    }
+  }
+  return false;
+}
+
 bool HasIntrinsicTypeName(const Symbol &symbol) {
   std::string name{symbol.name().ToString()};
   if (name == "doubleprecision") {
     return true;
   } else if (name == "derived") {
     return false;
   } else {
     for (int i{0}; i != common::TypeCategory_enumSize; ++i) {

flang/lib/Semantics/type.cpp

 bool DerivedTypeSpec::HasDefaultInitialization() const {
   DirectComponentIterator components{*this};
   return bool{std::find_if(
       components.begin(), components.end(), [&](const Symbol &component) {
         return IsInitialized(component, false, &typeSymbol());
       })};
 }
 
+bool DerivedTypeSpec::HasDestruction() const {
+  if (!typeSymbol().get<DerivedTypeDetails>().finals().empty()) {
+    return true;
+  }
+  DirectComponentIterator components{*this};
+  return bool{std::find_if(
+      components.begin(), components.end(), [&](const Symbol &component) {
+        return IsDestructible(component, &typeSymbol());
+      })};
+}
+
 ParamValue *DerivedTypeSpec::FindParameter(SourceName target) {
   return const_cast<ParamValue *>(
       const_cast<const DerivedTypeSpec *>(this)->FindParameter(target));
 }
 
 // Objects of derived types might be assignment compatible if they are equal
 // with respect to everything other than their instantiated type parameters
 // and their constant instantiated type parameters have the same values.
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;
+// Completes component derived type instantiation and initializer folding
+// for a non-parameterized derived type Scope.
+static void InstantiateNonPDTScope(Scope &typeScope, Scope &containingScope) {
   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());
-    context.SetError(typeSymbol_);
-    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);
-          }
-        }
-      }
-      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));
+  ComputeOffsets(context, typeScope);
+}
+
+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());
+    context.SetError(typeSymbol_);
+    return;
+  }
+  EvaluateParameters(context);
+  const Scope &typeScope{DEREF(typeSymbol_.scope())};
+  if (!MightBeParameterized()) {
+    scope_ = &typeScope;
+    if (typeScope.derivedTypeSpec()) {
+      CHECK(*this == *typeScope.derivedTypeSpec());
+    } else {
+      Scope &mutableTypeScope{const_cast<Scope &>(typeScope)};
+      mutableTypeScope.set_derivedTypeSpec(*this);
+      InstantiateNonPDTScope(mutableTypeScope, containingScope);
+    }
     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);

flang/module/__fortran_type_info.f90

module __Fortran_type_info
   type :: DerivedType
     ! "TBP" bindings appear first.  Inherited bindings, with overrides already
     ! applied, appear in the initial entries in the same order as they
     ! appear in the parent type's bindings, if any.  They are followed
     ! by new local bindings in alphabetic order of theing binding names.
     type(Binding), pointer, contiguous :: binding(:)
     character(len=:), pointer :: name
     integer(kind=int64) :: sizeInBytes
-    type(DerivedType), pointer :: parent
     ! Instances of parameterized derived types use the "uninstantiated"
     ! component to point to the pristine original definition.
     type(DerivedType), pointer :: uninstantiated
     integer(kind=int64) :: typeHash
     integer(kind=int64), pointer, contiguous :: kindParameter(:) ! values of instance
     integer(1), pointer, contiguous :: lenParameterKind(:) ! INTEGER kinds of LEN types
-    ! Data components appear in alphabetic order.
-    ! The parent component, if any, appears explicitly.
+    ! Data components appear in component order.
+    ! The parent component, if any, appears explicitly and first.
     type(Component), pointer, contiguous :: component(:) ! data components
     type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
     ! Special bindings of the ancestral types are not duplicated here.
     type(SpecialBinding), pointer, contiguous :: special(:)
+    integer(1) :: hasParent
+    integer(1) :: noInitializationNeeded ! 1 if no component w/ init
+    integer(1) :: noDestructionNeeded ! 1 if no component w/ dealloc/final
+    integer(1) :: __padding0(5)
   end type
 
   type :: Binding
     type(__builtin_c_funptr) :: proc
     character(len=:), pointer :: name
   end type
 
   ! Array bounds and type parameters of components are deferred

flang/runtime/CMakeLists.txt

add_flang_library(FortranRuntime
   ISO_Fortran_binding.cpp
   allocatable.cpp
   buffer.cpp
   complex-reduction.c
   copy.cpp
   character.cpp
   connection.cpp
   derived.cpp
+  derived-api.cpp
   descriptor.cpp
   descriptor-io.cpp
   dot-product.cpp
   edit-input.cpp
   edit-output.cpp
   environment.cpp
   extrema.cpp
   file.cpp

flang/runtime/allocatable.h

int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor &from,
     const char *sourceFile = nullptr, int sourceLine = 0);
 
 // Deallocates an allocatable.  Finalizes elements &/or components as needed.
 // The allocatable is left in an initialized state suitable for reallocation
 // with the same bounds, cobounds, and length type parameters.
 int RTNAME(AllocatableDeallocate)(Descriptor &, bool hasStat = false,
     const Descriptor *errMsg = nullptr, const char *sourceFile = nullptr,
     int sourceLine = 0);
-}
+
+// Variant of above that does not finalize; for intermediate results
+void RTNAME(AllocatableDeallocateNoFinal)(
+    Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
+} // extern "C"
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_ALLOCATABLE_H_

flang/runtime/allocatable.cpp

 //===-- runtime/allocatable.cpp -------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "allocatable.h"
+#include "derived.h"
 #include "stat.h"
 #include "terminator.h"
+#include "type-info.h"
 
 namespace Fortran::runtime {
 extern "C" {
 
 void RTNAME(AllocatableInitIntrinsic)(Descriptor &descriptor,
     TypeCategory category, int kind, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(TypeCode{category, kind},

 void RTNAME(AllocatableInitDerived)(Descriptor &descriptor,
     const typeInfo::DerivedType &derivedType, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   descriptor.Establish(
       derivedType, nullptr, rank, nullptr, CFI_attribute_allocatable);
 }
 
 void RTNAME(AllocatableAssign)(Descriptor &to, const Descriptor & /*from*/) {
-  INTERNAL_CHECK(false); // AllocatableAssign is not yet implemented
+  INTERNAL_CHECK(false); // TODO: AllocatableAssign is not yet implemented
 }
 
 int RTNAME(MoveAlloc)(Descriptor &to, const Descriptor & /*from*/,
     bool /*hasStat*/, const Descriptor * /*errMsg*/,
     const char * /*sourceFile*/, int /*sourceLine*/) {
-  INTERNAL_CHECK(false); // MoveAlloc is not yet implemented
+  INTERNAL_CHECK(false); // TODO: MoveAlloc is not yet implemented
   return StatOk;
 }
 
 void RTNAME(AllocatableSetBounds)(Descriptor &descriptor, int zeroBasedDim,
     SubscriptValue lower, SubscriptValue upper) {
   INTERNAL_CHECK(zeroBasedDim >= 0 && zeroBasedDim < descriptor.rank());
   descriptor.GetDimension(zeroBasedDim).SetBounds(lower, upper);
   // The byte strides are computed when the object is allocated.
int RTNAME(AllocatableAllocate)(Descriptor &descriptor, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!descriptor.IsAllocatable()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
   if (descriptor.IsAllocated()) {
     return ReturnError(terminator, StatBaseNotNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat);
-  // TODO: default component initialization
+  int stat{ReturnError(terminator, descriptor.Allocate(), errMsg, hasStat)};
+  if (stat == StatOk) {
+    if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
+      if (const auto *derived{addendum->derivedType()}) {
+        if (!derived->noInitializationNeeded()) {
+          stat = Initialize(descriptor, *derived, terminator, hasStat, errMsg);
+        }
+      }
+    }
+  }
+  return stat;
 }
 
 int RTNAME(AllocatableDeallocate)(Descriptor &descriptor, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!descriptor.IsAllocatable()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
   if (!descriptor.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, descriptor.Deallocate(), errMsg, hasStat);
+  return ReturnError(terminator, descriptor.Destroy(true), errMsg, hasStat);
+}
+
+void RTNAME(AllocatableDeallocateNoFinal)(
+    Descriptor &descriptor, const char *sourceFile, int sourceLine) {
+  Terminator terminator{sourceFile, sourceLine};
+  if (!descriptor.IsAllocatable()) {
+    ReturnError(terminator, StatInvalidDescriptor);
+  } else if (!descriptor.IsAllocated()) {
+    ReturnError(terminator, StatBaseNull);
+  } else {
+    ReturnError(terminator, descriptor.Destroy(false));
+  }
 }
 
 // TODO: AllocatableCheckLengthParameter, AllocatableAllocateSource
 }
 } // namespace Fortran::runtime

flang/runtime/derived-api.h

+//===-- runtime/derived-api.h ---------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+// API for lowering to use for operations on derived type objects.
+// Initialiaztion and finalization are implied for pointer and allocatable
+// ALLOCATE()/DEALLOCATE() respectively, so these APIs should be used only for
+// local variables.  Whole allocatable assignment should use AllocatableAssign()
+// instead of this Assign().
+
+#ifndef FLANG_RUNTIME_DERIVED_API_H_
+#define FLANG_RUNTIME_DERIVED_API_H_
+
+#include "entry-names.h"
+
+namespace Fortran::runtime {
+class Descriptor;
+
+extern "C" {
+
+// Initializes and allocates an object's components, if it has a derived type
+// with any default component initialization or automatic components.
+// The descriptor must be initialized and non-null.
+void RTNAME(Initialize)(
+    const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
+
+// Finalizes an object and its components.  Deallocates any
+// allocatable/automatic components.  Does not deallocate the descriptor's
+// storage.
+void RTNAME(Destroy)(const Descriptor &);
+
+// Intrinsic or defined assignment, with scalar expansion but not type
+// conversion.
+void RTNAME(Assign)(const Descriptor &, const Descriptor &,
+    const char *sourceFile = nullptr, int sourceLine = 0);
+
+} // extern "C"
+} // namespace Fortran::runtime
+#endif // FLANG_RUNTIME_DERIVED_API_H_

flang/runtime/derived-api.cpp

+//===-- runtime/derived-api.cpp
+//-----------------------------------------------===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+
+#include "derived-api.h"
+#include "derived.h"
+#include "descriptor.h"
+#include "terminator.h"
+#include "type-info.h"
+
+namespace Fortran::runtime {
+
+extern "C" {
+
+void RTNAME(Initialize)(
+    const Descriptor &descriptor, const char *sourceFile, int sourceLine) {
+  if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
+    if (const auto *derived{addendum->derivedType()}) {
+      if (!derived->noInitializationNeeded()) {
+        Terminator terminator{sourceFile, sourceLine};
+        Initialize(descriptor, *derived, terminator);
+      }
+    }
+  }
+}
+
+void RTNAME(Destroy)(const Descriptor &descriptor) {
+  if (const DescriptorAddendum * addendum{descriptor.Addendum()}) {
+    if (const auto *derived{addendum->derivedType()}) {
+      if (!derived->noDestructionNeeded()) {
+        Destroy(descriptor, true, *derived);
+      }
+    }
+  }
+}
+
+// TODO: Assign()
+
+} // extern "C"
+} // namespace Fortran::runtime

flang/runtime/derived.h

 //===-- runtime/derived.h -------------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
+// Internal runtime utilities for derived type operations.
+
 #ifndef FLANG_RUNTIME_DERIVED_H_
 #define FLANG_RUNTIME_DERIVED_H_
 
 namespace Fortran::runtime::typeInfo {
 class DerivedType;
 }
 
 namespace Fortran::runtime {
 class Descriptor;
+class Terminator;
+
+// Perform default component initialization, allocate automatic components.
+// Returns a STAT= code (0 when all's well).
+int Initialize(const Descriptor &, const typeInfo::DerivedType &, Terminator &,
+    bool hasStat = false, const Descriptor *errMsg = nullptr);
+
+// Call FINAL subroutines, deallocate allocatable & automatic components.
+// Does not deallocate the original descriptor.
 void Destroy(const Descriptor &, bool finalize, const typeInfo::DerivedType &);
+
+// Assigns one object to another via intrinsic assignment (F'2018 10.2.1.3) or
+// defined assignment (10.2.1.4), as appropriate.  Performs scalar expansion
+// or allocatable reallocation as needed.  Does not perform intrinsic
+// assignment implicit type conversion.
+void Assign(Descriptor &, const Descriptor &, const typeInfo::DerivedType &,
+    Terminator &);
+
 } // namespace Fortran::runtime
-#endif // FLANG_RUNTIME_FINAL_H_
+#endif // FLANG_RUNTIME_DERIVED_H_

flang/runtime/derived.cpp

 //===-- runtime/derived.cpp -----------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "derived.h"
 #include "descriptor.h"
+#include "stat.h"
+#include "terminator.h"
 #include "type-info.h"
 
 namespace Fortran::runtime {
 
+int Initialize(const Descriptor &instance, const typeInfo::DerivedType &derived,
+    Terminator &terminator, bool hasStat, const Descriptor *errMsg) {
+  const Descriptor &componentDesc{derived.component()};
+  std::size_t elements{instance.Elements()};
+  std::size_t byteStride{instance.ElementBytes()};
+  int stat{StatOk};
+  // Initialize data components in each element; the per-element iteration
+  // constitutes the inner loops, not outer
+  std::size_t myComponents{componentDesc.Elements()};
+  for (std::size_t k{0}; k < myComponents; ++k) {
+    const auto &comp{
+        *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
+    if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
+        comp.genre() == typeInfo::Component::Genre::Automatic) {
+      for (std::size_t j{0}; j < elements; ++j) {
+        Descriptor &allocDesc{*instance.OffsetElement<Descriptor>(
+            j * byteStride + comp.offset())};
+        comp.EstablishDescriptor(allocDesc, instance, terminator);
+        allocDesc.raw().attribute = CFI_attribute_allocatable;
+        if (comp.genre() == typeInfo::Component::Genre::Automatic) {
+          stat = ReturnError(terminator, allocDesc.Allocate(), errMsg, hasStat);
+          if (stat == StatOk) {
+            stat = Initialize(allocDesc, derived, terminator, hasStat, errMsg);
+          }
+          if (stat != StatOk) {
+            break;
+          }
+        }
+      }
+    } else if (const void *init{comp.initialization()}) {
+      // Explicit initialization of data pointers and
+      // non-allocatable non-automatic components
+      std::size_t bytes{comp.SizeInBytes(instance)};
+      for (std::size_t j{0}; j < elements; ++j) {
+        char *ptr{instance.OffsetElement<char>(j * byteStride + comp.offset())};
+        std::memcpy(ptr, init, bytes);
+      }
+    } else if (comp.genre() == typeInfo::Component::Genre::Data &&
+        comp.derivedType() && !comp.derivedType()->noInitializationNeeded()) {
+      // Default initialization of non-pointer non-allocatable/automatic
+      // data component.  Handles parent component's elements.  Recursive.
+      SubscriptValue extent[maxRank];
+      const typeInfo::Value *bounds{comp.bounds()};
+      for (int dim{0}; dim < comp.rank(); ++dim) {
+        typeInfo::TypeParameterValue lb{
+            bounds[2 * dim].GetValue(&instance).value_or(0)};
+        typeInfo::TypeParameterValue ub{
+            bounds[2 * dim + 1].GetValue(&instance).value_or(0)};
+        extent[dim] = ub >= lb ? ub - lb + 1 : 0;
+      }
+      StaticDescriptor<maxRank, true, 0> staticDescriptor;
+      Descriptor &compDesc{staticDescriptor.descriptor()};
+      const typeInfo::DerivedType &compType{*comp.derivedType()};
+      for (std::size_t j{0}; j < elements; ++j) {
+        compDesc.Establish(compType,
+            instance.OffsetElement<char>(j * byteStride + comp.offset()),
+            comp.rank(), extent);
+        stat = Initialize(compDesc, compType, terminator, hasStat, errMsg);
+        if (stat != StatOk) {
+          break;
+        }
+      }
+    }
+  }
+  // Initialize procedure pointer components in each element
+  const Descriptor &procPtrDesc{derived.procPtr()};
+  std::size_t myProcPtrs{procPtrDesc.Elements()};
+  for (std::size_t k{0}; k < myProcPtrs; ++k) {
+    const auto &comp{
+        *procPtrDesc.ZeroBasedIndexedElement<typeInfo::ProcPtrComponent>(k)};
+    for (std::size_t j{0}; j < elements; ++j) {
+      auto &pptr{*instance.OffsetElement<typeInfo::ProcedurePointer>(
+          j * byteStride + comp.offset)};
+      pptr = comp.procInitialization;
+    }
+  }
+  return stat;
+}
+
 static const typeInfo::SpecialBinding *FindFinal(
     const typeInfo::DerivedType &derived, int rank) {
   const typeInfo::SpecialBinding *elemental{nullptr};
   const Descriptor &specialDesc{derived.special()};
   std::size_t totalSpecialBindings{specialDesc.Elements()};
   for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
     const auto &special{
         *specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
     }
   }
   return elemental;
 }
 
 static void CallFinalSubroutine(
     const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
   if (const auto *special{FindFinal(derived, descriptor.rank())}) {
+    // The following code relies on the fact that finalizable objects
+    // must be contiguous.
     if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) {
       std::size_t byteStride{descriptor.ElementBytes()};
-      auto *p{special->GetProc<void (*)(char *)>()};
-      // Finalizable objects must be contiguous.
       std::size_t elements{descriptor.Elements()};
+      if (special->IsArgDescriptor(0)) {
+        StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
+        Descriptor &elemDesc{statDesc.descriptor()};
+        elemDesc = descriptor;
+        elemDesc.raw().attribute = CFI_attribute_pointer;
+        elemDesc.raw().rank = 0;
+        auto *p{special->GetProc<void (*)(const Descriptor &)>()};
+        for (std::size_t j{0}; j < elements; ++j) {
+          elemDesc.set_base_addr(
+              descriptor.OffsetElement<char>(j * byteStride));
+          p(elemDesc);
+        }
+      } else {
+        auto *p{special->GetProc<void (*)(char *)>()};
         for (std::size_t j{0}; j < elements; ++j) {
           p(descriptor.OffsetElement<char>(j * byteStride));
         }
+      }
     } else if (special->IsArgDescriptor(0)) {
+      StaticDescriptor<maxRank, true, 8 /*?*/> statDesc;
+      Descriptor &tmpDesc{statDesc.descriptor()};
+      tmpDesc = descriptor;
+      tmpDesc.raw().attribute = CFI_attribute_pointer;
+      tmpDesc.Addendum()->set_derivedType(&derived);
       auto *p{special->GetProc<void (*)(const Descriptor &)>()};
-      p(descriptor);
+      p(tmpDesc);
     } else {
-      // Finalizable objects must be contiguous.
       auto *p{special->GetProc<void (*)(char *)>()};
       p(descriptor.OffsetElement<char>());
     }
   }
 }
 
 // The order of finalization follows Fortran 2018 7.5.6.2, with
 // deallocation of non-parent components (and their consequent finalization)
 // taking place before parent component finalization.
 void Destroy(const Descriptor &descriptor, bool finalize,
     const typeInfo::DerivedType &derived) {
   if (finalize) {
     CallFinalSubroutine(descriptor, derived);
   }
   const Descriptor &componentDesc{derived.component()};
-  auto myComponents{static_cast<SubscriptValue>(componentDesc.Elements())};
+  std::size_t myComponents{componentDesc.Elements()};
   std::size_t elements{descriptor.Elements()};
   std::size_t byteStride{descriptor.ElementBytes()};
-  for (unsigned k{0}; k < myComponents; ++k) {
+  // If there's a finalizable parent component, handle it last, as required
+  // by the Fortran standard (7.5.6.2), and do so recursively with the same
+  // descriptor so that the rank is preserved.  Otherwise, destroy the parent
+  // component like any other.
+  const auto *parentType{derived.GetParentType()};
+  bool recurse{finalize && parentType && !parentType->noDestructionNeeded()};
+  for (auto k{recurse
+               ? std::size_t{1} /* skip first component, it's the parent */
+               : 0};
+       k < myComponents; ++k) {
     const auto &comp{
         *componentDesc.ZeroBasedIndexedElement<typeInfo::Component>(k)};
     if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
         comp.genre() == typeInfo::Component::Genre::Automatic) {
+      if (const typeInfo::DerivedType * compType{comp.derivedType()}) {
+        if (!compType->noDestructionNeeded()) {
+          for (std::size_t j{0}; j < elements; ++j) {
+            Destroy(*descriptor.OffsetElement<Descriptor>(
+                        j * byteStride + comp.offset()),
+                finalize, *compType);
+          }
+        }
+      }
       for (std::size_t j{0}; j < elements; ++j) {
         descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset())
-            ->Deallocate(finalize);
+            ->Deallocate();
       }
     } else if (comp.genre() == typeInfo::Component::Genre::Data &&
-        comp.derivedType()) {
+        comp.derivedType() && !comp.derivedType()->noDestructionNeeded()) {
       SubscriptValue extent[maxRank];
       const typeInfo::Value *bounds{comp.bounds()};
       for (int dim{0}; dim < comp.rank(); ++dim) {
         extent[dim] = bounds[2 * dim].GetValue(&descriptor).value_or(0) -
             bounds[2 * dim + 1].GetValue(&descriptor).value_or(0) + 1;
       }
       StaticDescriptor<maxRank, true, 0> staticDescriptor;
       Descriptor &compDesc{staticDescriptor.descriptor()};
       const typeInfo::DerivedType &compType{*comp.derivedType()};
       for (std::size_t j{0}; j < elements; ++j) {
         compDesc.Establish(compType,
             descriptor.OffsetElement<char>(j * byteStride + comp.offset()),
             comp.rank(), extent);
         Destroy(compDesc, finalize, compType);
       }
     }
   }
-  const Descriptor &parentDesc{derived.parent()};
-  if (const auto *parent{parentDesc.OffsetElement<typeInfo::DerivedType>()}) {
-    Destroy(descriptor, finalize, *parent);
+  if (recurse) {
+    Destroy(descriptor, finalize, *parentType);
   }
 }
+
+// TODO: Assign()
+
 } // namespace Fortran::runtime

flang/runtime/descriptor-io.h

 template <Direction DIR>
 static bool DefaultFormattedComponentIO(IoStatementState &io,
     const typeInfo::Component &component, const Descriptor &origDescriptor,
     const SubscriptValue origSubscripts[], Terminator &terminator) {
   if (component.genre() == typeInfo::Component::Genre::Data) {
     // Create a descriptor for the component
     StaticDescriptor<maxRank, true, 16 /*?*/> statDesc;
     Descriptor &desc{statDesc.descriptor()};
-    component.EstablishDescriptor(
+    component.CreatePointerDescriptor(
         desc, origDescriptor, origSubscripts, terminator);
     return DescriptorIO<DIR>(io, desc);
   } else {
     // Component is itself a descriptor
     char *pointer{
         origDescriptor.Element<char>(origSubscripts) + component.offset()};
     RUNTIME_CHECK(
         terminator, component.genre() == typeInfo::Component::Genre::Automatic);

flang/runtime/descriptor.h

public:
   void SetLenParameterValue(int which, typeInfo::TypeParameterValue x) {
     len_[which] = x;
   }
 
   void Dump(FILE * = stdout) const;
 
 private:
   const typeInfo::DerivedType *derivedType_;
+  std::uint64_t __unused_flags_{0}; // TODO: delete
   typeInfo::TypeParameterValue len_[1]; // must be the last component
   // The LEN type parameter values can also include captured values of
   // specification expressions that were used for bounds and for LEN type
   // parameters of components.  The values have been truncated to the LEN
   // type parameter's type, if shorter than 64 bits, then sign-extended.
 };
 
 // A C++ view of a standard descriptor object.
 class Descriptor {
 public:
   // Be advised: this class type is not suitable for use when allocating
   // a descriptor -- it is a dynamic view of the common descriptor format.
   // If used in a simple declaration of a local variable or dynamic allocation,
   // the size is going to be correct only by accident, since the true size of
   // a descriptor depends on the number of its dimensions and the presence and
   // size of an addendum, which depends on the type of the data.
   // Use the class template StaticDescriptor (below) to declare a descriptor
   // whose type and rank are fixed and known at compilation time.  Use the
   // Create() static member functions otherwise to dynamically allocate a
   // descriptor.
 
   Descriptor(const Descriptor &);
-  ~Descriptor();
   Descriptor &operator=(const Descriptor &);
 
   static constexpr std::size_t BytesFor(TypeCategory category, int kind) {
     return category == TypeCategory::Complex ? kind * 2 : kind;
   }
 
   void Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
public:
 
   std::size_t SizeInBytes() const;
 
   std::size_t Elements() const;
 
   // Allocate() assumes Elements() and ElementBytes() work;
   // define the extents of the dimensions and the element length
   // before calling.  It (re)computes the byte strides after
-  // allocation.
-  // TODO: SOURCE= and MOLD=
+  // allocation.  Does not allocate automatic components or
+  // perform default component initialization.
   int Allocate();
-  int Deallocate(bool finalize = true);
-  void Destroy(bool finalize = true) const;
+
+  // Deallocates storage; does not call FINAL subroutines or
+  // deallocate allocatable/automatic components.
+  int Deallocate();
+
+  // Deallocates storage, including allocatable and automatic
+  // components.  Optionally invokes FINAL subroutines.
+  int Destroy(bool finalize = false);
 
   bool IsContiguous(int leadingDimensions = maxRank) const {
     auto bytes{static_cast<SubscriptValue>(ElementBytes())};
     for (int j{0}; j < leadingDimensions && j < raw_.rank; ++j) {
       const Dimension &dim{GetDimension(j)};
       if (bytes != dim.ByteStride()) {
         return false;
       }

 class alignas(Descriptor) StaticDescriptor {
 public:
   static constexpr int maxRank{MAX_RANK};
   static constexpr int maxLengthTypeParameters{MAX_LEN_PARMS};
   static constexpr bool hasAddendum{ADDENDUM || MAX_LEN_PARMS > 0};
   static constexpr std::size_t byteSize{
       Descriptor::SizeInBytes(maxRank, hasAddendum, maxLengthTypeParameters)};
 
-  ~StaticDescriptor() { descriptor().~Descriptor(); }
-
   Descriptor &descriptor() { return *reinterpret_cast<Descriptor *>(storage_); }
   const Descriptor &descriptor() const {
     return *reinterpret_cast<const Descriptor *>(storage_);
   }
 
   void Check() {
     assert(descriptor().rank() <= maxRank);
     assert(descriptor().SizeInBytes() <= byteSize);

flang/runtime/descriptor.cpp

 //===-- runtime/descriptor.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "descriptor.h"
 #include "derived.h"
 #include "memory.h"
+#include "stat.h"
 #include "terminator.h"
 #include "type-info.h"
 #include <cassert>
 #include <cstdlib>
 #include <cstring>
 
 namespace Fortran::runtime {
 
 Descriptor::Descriptor(const Descriptor &that) { *this = that; }
 
-Descriptor::~Descriptor() {
-  if (raw_.attribute != CFI_attribute_pointer) {
-    Deallocate();
-  }
-}
-
 Descriptor &Descriptor::operator=(const Descriptor &that) {
   std::memcpy(this, &that, that.SizeInBytes());
   return *this;
 }
 
 void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {

 
 int Descriptor::Allocate() {
   std::size_t byteSize{Elements() * ElementBytes()};
   void *p{std::malloc(byteSize)};
   if (!p && byteSize) {
     return CFI_ERROR_MEM_ALLOCATION;
   }
   // TODO: image synchronization
-  // TODO: derived type initialization
   raw_.base_addr = p;
   if (int dims{rank()}) {
     std::size_t stride{ElementBytes()};
     for (int j{0}; j < dims; ++j) {
       auto &dimension{GetDimension(j)};
       dimension.SetByteStride(stride);
       stride *= dimension.Extent();
     }
   }
   return 0;
 }
 
-int Descriptor::Deallocate(bool finalize) {
-  Destroy(finalize);
-  return ISO::CFI_deallocate(&raw_);
+int Descriptor::Destroy(bool finalize) {
+  if (raw_.attribute == CFI_attribute_pointer) {
+    return StatOk;
+  } else {
+    if (auto *addendum{Addendum()}) {
+      if (const auto *derived{addendum->derivedType()}) {
+        if (!derived->noDestructionNeeded()) {
+          runtime::Destroy(*this, finalize, *derived);
         }
-
-void Descriptor::Destroy(bool finalize) const {
-  if (const DescriptorAddendum * addendum{Addendum()}) {
-    if (const typeInfo::DerivedType * dt{addendum->derivedType()}) {
-      runtime::Destroy(*this, finalize, *dt);
       }
     }
+    return Deallocate();
   }
+}
+
+int Descriptor::Deallocate() { return ISO::CFI_deallocate(&raw_); }
 
 bool Descriptor::IncrementSubscripts(
     SubscriptValue *subscript, const int *permutation) const {
   for (int j{0}; j < raw_.rank; ++j) {
     int k{permutation ? permutation[j] : j};
     const Dimension &dim{GetDimension(k)};
     if (subscript[k]++ < dim.UpperBound()) {
       return true;

flang/runtime/namelist.cpp

static bool HandleComponent(IoStatementState &io, Descriptor &desc,
   io.HandleRelativePosition(1); // skip '%'
   char compName[nameBufferSize];
   if (GetLowerCaseName(io, compName, sizeof compName)) {
     const DescriptorAddendum *addendum{source.Addendum()};
     if (const typeInfo::DerivedType *
         type{addendum ? addendum->derivedType() : nullptr}) {
       if (const typeInfo::Component *
           comp{type->FindDataComponent(compName, std::strlen(compName))}) {
-        comp->EstablishDescriptor(desc, source, nullptr, handler);
+        comp->CreatePointerDescriptor(desc, source, nullptr, handler);
         return true;
       } else {
         handler.SignalError(
             "NAMELIST component reference '%%%s' of input group item %s is not "
             "a component of its derived type",
             compName, name);
       }
     } else {

flang/runtime/pointer.cpp

 //===-- runtime/pointer.cpp -----------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "pointer.h"
+#include "derived.h"
 #include "stat.h"
 #include "terminator.h"
 #include "tools.h"
+#include "type-info.h"
 
 namespace Fortran::runtime {
 extern "C" {
 
 void RTNAME(PointerNullifyIntrinsic)(Descriptor &pointer, TypeCategory category,
     int kind, int rank, int corank) {
   INTERNAL_CHECK(corank == 0);
   pointer.Establish(TypeCode{category, kind},

 }
 
 int RTNAME(PointerAllocate)(Descriptor &pointer, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!pointer.IsPointer()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
-  return ReturnError(terminator, pointer.Allocate(), errMsg, hasStat);
-  // TODO: default component initialization
+  int stat{ReturnError(terminator, pointer.Allocate(), errMsg, hasStat)};
+  if (stat == StatOk) {
+    if (const DescriptorAddendum * addendum{pointer.Addendum()}) {
+      if (const auto *derived{addendum->derivedType()}) {
+        if (!derived->noInitializationNeeded()) {
+          stat = Initialize(pointer, *derived, terminator, hasStat, errMsg);
+        }
+      }
+    }
+  }
+  return stat;
 }
 
 int RTNAME(PointerDeallocate)(Descriptor &pointer, bool hasStat,
     const Descriptor *errMsg, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (!pointer.IsPointer()) {
     return ReturnError(terminator, StatInvalidDescriptor, errMsg, hasStat);
   }
   if (!pointer.IsAllocated()) {
     return ReturnError(terminator, StatBaseNull, errMsg, hasStat);
   }
-  return ReturnError(terminator, pointer.Deallocate(), errMsg, hasStat);
+  return ReturnError(terminator, pointer.Destroy(true), errMsg, hasStat);
 }
 
 bool RTNAME(PointerIsAssociated)(const Descriptor &pointer) {
   return pointer.raw().base_addr != nullptr;
 }
 
 bool RTNAME(PointerIsAssociatedWith)(
     const Descriptor &pointer, const Descriptor &target) {

flang/runtime/type-info.h

public:
   const Value *lenValue() const {
     return lenValue_.descriptor().OffsetElement<const Value>();
   }
   const Value *bounds() const {
     return bounds_.descriptor().OffsetElement<const Value>();
   }
   const char *initialization() const { return initialization_; }
 
-  // Creates a pointer descriptor from a component description.
-  void EstablishDescriptor(Descriptor &, const Descriptor &container,
+  std::size_t GetElementByteSize(const Descriptor &) const;
+  std::size_t GetElements(const Descriptor &) const;
+
+  // For ocmponents that are descriptors, returns size of descriptor;
+  // for Genre::Data, returns elemental byte size times element count.
+  std::size_t SizeInBytes(const Descriptor &) const;
+
+  // Establishes a descriptor from this component description.
+  void EstablishDescriptor(
+      Descriptor &, const Descriptor &container, Terminator &) const;
+
+  // Creates a pointer descriptor from this component description.
+  void CreatePointerDescriptor(Descriptor &, const Descriptor &container,
       const SubscriptValue[], Terminator &) const;
 
   FILE *Dump(FILE * = stdout) const;
 
 private:
   StaticDescriptor<0> name_; // CHARACTER(:), POINTER
   Genre genre_{Genre::Data};
   std::uint8_t category_; // common::TypeCategory
private:
   const char *initialization_{nullptr}; // for Genre::Data and Pointer
   // TODO: cobounds
   // TODO: `PRIVATE` attribute
 };
 
 struct ProcPtrComponent {
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
   std::uint64_t offset{0};
-  ProcedurePointer procInitialization; // for Genre::Procedure
+  ProcedurePointer procInitialization;
 };
 
 class SpecialBinding {
 public:
   enum class Which : std::uint8_t {
     None = 0,
     Assignment = 4,
     ElementalAssignment = 5,

 
 class DerivedType {
 public:
   ~DerivedType(); // never defined
 
   const Descriptor &binding() const { return binding_.descriptor(); }
   const Descriptor &name() const { return name_.descriptor(); }
   std::uint64_t sizeInBytes() const { return sizeInBytes_; }
-  const Descriptor &parent() const { return parent_.descriptor(); }
   std::uint64_t typeHash() const { return typeHash_; }
   const Descriptor &uninstatiated() const {
     return uninstantiated_.descriptor();
   }
   const Descriptor &kindParameter() const {
     return kindParameter_.descriptor();
   }
   const Descriptor &lenParameterKind() const {
     return lenParameterKind_.descriptor();
   }
   const Descriptor &component() const { return component_.descriptor(); }
   const Descriptor &procPtr() const { return procPtr_.descriptor(); }
   const Descriptor &special() const { return special_.descriptor(); }
+  bool hasParent() const { return hasParent_; }
+  bool noInitializationNeeded() const { return noInitializationNeeded_; }
+  bool noDestructionNeeded() const { return noDestructionNeeded_; }
 
   std::size_t LenParameters() const { return lenParameterKind().Elements(); }
 
+  const DerivedType *GetParentType() const;
+
   // Finds a data component by name in this derived type or tis ancestors.
   const Component *FindDataComponent(
       const char *name, std::size_t nameLen) const;
 
   const SpecialBinding *FindSpecialBinding(SpecialBinding::Which) const;
 
   FILE *Dump(FILE * = stdout) const;
 
 private:
   // This member comes first because it's used like a vtable by generated code.
   // It includes all of the ancestor types' bindings, if any, first,
   // with any overrides from descendants already applied to them.  Local
   // bindings then follow in alphabetic order of binding name.
   StaticDescriptor<1, true>
       binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
 
   StaticDescriptor<0> name_; // CHARACTER(:), POINTER
 
   std::uint64_t sizeInBytes_{0};
-  StaticDescriptor<0, true> parent_; // TYPE(DERIVEDTYPE), POINTER
 
   // Instantiations of a parameterized derived type with KIND type
   // parameters will point this data member to the description of
   // the original uninstantiated type, which may be shared from a
   // module via use association.  The original uninstantiated derived
   // type description will point to itself.  Derived types that have
   // no KIND type parameters will have a null pointer here.
   StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
private:
 
   // Procedure pointer components
   StaticDescriptor<1, true>
       procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
 
   // Does not include special bindings from ancestral types.
   StaticDescriptor<1, true>
       special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
+
+  bool hasParent_{false};
+  bool noInitializationNeeded_{false};
+  bool noDestructionNeeded_{false};
 };
 
 } // namespace Fortran::runtime::typeInfo
 #endif // FORTRAN_RUNTIME_TYPE_INFO_H_

flang/runtime/type-info.cpp

if (descriptor) {
       }
     }
     return std::nullopt;
   default:
     return std::nullopt;
   }
 }
 
+std::size_t Component::GetElementByteSize(const Descriptor &instance) const {
+  switch (category()) {
+  case TypeCategory::Integer:
+  case TypeCategory::Real:
+  case TypeCategory::Logical:
+    return kind_;
+  case TypeCategory::Complex:
+    return 2 * kind_;
+  case TypeCategory::Character:
+    if (auto value{characterLen_.GetValue(&instance)}) {
+      return kind_ * *value;
+    }
+    break;
+  case TypeCategory::Derived:
+    if (const auto *type{derivedType()}) {
+      return type->sizeInBytes();
+    }
+    break;
+  }
+  return 0;
+}
+
+std::size_t Component::GetElements(const Descriptor &instance) const {
+  std::size_t elements{1};
+  if (int rank{rank_}) {
+    if (const Value * boundValues{bounds()}) {
+      for (int j{0}; j < rank; ++j) {
+        TypeParameterValue lb{
+            boundValues[2 * j].GetValue(&instance).value_or(0)};
+        TypeParameterValue ub{
+            boundValues[2 * j + 1].GetValue(&instance).value_or(0)};
+        if (ub >= lb) {
+          elements *= ub - lb + 1;
+        } else {
+          return 0;
+        }
+      }
+    } else {
+      return 0;
+    }
+  }
+  return elements;
+}
+
+std::size_t Component::SizeInBytes(const Descriptor &instance) const {
+  if (genre() == Genre::Data) {
+    return GetElementByteSize(instance) * GetElements(instance);
+  } else if (category() == TypeCategory::Derived) {
+    const DerivedType *type{derivedType()};
+    return Descriptor::SizeInBytes(
+        rank_, true, type ? type->LenParameters() : 0);
+  } else {
+    return Descriptor::SizeInBytes(rank_);
+  }
+}
+
 void Component::EstablishDescriptor(Descriptor &descriptor,
-    const Descriptor &container, const SubscriptValue subscripts[],
-    Terminator &terminator) const {
-  RUNTIME_CHECK(terminator, genre_ == Genre::Data);
+    const Descriptor &container, Terminator &terminator) const {
   TypeCategory cat{category()};
   if (cat == TypeCategory::Character) {
     auto length{characterLen_.GetValue(&container)};
     RUNTIME_CHECK(terminator, length.has_value());
     descriptor.Establish(kind_, *length / kind_, nullptr, rank_);
   } else if (cat == TypeCategory::Derived) {
     const DerivedType *type{derivedType()};
     RUNTIME_CHECK(terminator, type != nullptr);
     descriptor.Establish(*type, nullptr, rank_);
   } else {
     descriptor.Establish(cat, kind_, nullptr, rank_);
   }
-  if (rank_) {
+  if (rank_ && genre_ != Genre::Allocatable) {
     const typeInfo::Value *boundValues{bounds()};
     RUNTIME_CHECK(terminator, boundValues != nullptr);
     auto byteStride{static_cast<SubscriptValue>(descriptor.ElementBytes())};
     for (int j{0}; j < rank_; ++j) {
       auto lb{boundValues++->GetValue(&container)};
       auto ub{boundValues++->GetValue(&container)};
       RUNTIME_CHECK(terminator, lb.has_value() && ub.has_value());
       Dimension &dim{descriptor.GetDimension(j)};
       dim.SetBounds(*lb, *ub);
       dim.SetByteStride(byteStride);
       byteStride *= dim.Extent();
     }
   }
+}
+
+void Component::CreatePointerDescriptor(Descriptor &descriptor,
+    const Descriptor &container, const SubscriptValue subscripts[],
+    Terminator &terminator) const {
+  RUNTIME_CHECK(terminator, genre_ == Genre::Data);
+  EstablishDescriptor(descriptor, container, terminator);
   descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
+  descriptor.raw().attribute = CFI_attribute_pointer;
+}
+
+const DerivedType *DerivedType::GetParentType() const {
+  if (hasParent_) {
+    const Descriptor &compDesc{component()};
+    const Component &component{*compDesc.OffsetElement<const Component>()};
+    return component.derivedType();
+  } else {
+    return nullptr;
+  }
 }
 
 const Component *DerivedType::FindDataComponent(
     const char *compName, std::size_t compNameLen) const {
   const Descriptor &compDesc{component()};
   std::size_t n{compDesc.Elements()};
   SubscriptValue at[maxRank];
   compDesc.GetLowerBounds(at);
   for (std::size_t j{0}; j < n; ++j, compDesc.IncrementSubscripts(at)) {
     const Component *component{compDesc.Element<Component>(at)};
     INTERNAL_CHECK(component != nullptr);
     const Descriptor &nameDesc{component->name()};
     if (nameDesc.ElementBytes() == compNameLen &&
         std::memcmp(compName, nameDesc.OffsetElement(), compNameLen) == 0) {
       return component;
     }
   }
-  const DerivedType *ancestor{parent().OffsetElement<DerivedType>()};
-  return ancestor ? ancestor->FindDataComponent(compName, compNameLen)
-                  : nullptr;
+  const DerivedType *parent{GetParentType()};
+  return parent ? parent->FindDataComponent(compName, compNameLen) : nullptr;
 }
 
 const SpecialBinding *DerivedType::FindSpecialBinding(
     SpecialBinding::Which which) const {
   const Descriptor &specialDesc{special()};
   std::size_t n{specialDesc.Elements()};
   SubscriptValue at[maxRank];
   specialDesc.GetLowerBounds(at);

 }
 
 FILE *DerivedType::Dump(FILE *f) const {
   std::fprintf(
       f, "DerivedType @ 0x%p:\n", reinterpret_cast<const void *>(this));
   const std::uint64_t *uints{reinterpret_cast<const std::uint64_t *>(this)};
   for (int j{0}; j < 64; ++j) {
     int offset{j * static_cast<int>(sizeof *uints)};
-    std::fprintf(f, "    [+%3d](0x%p) %#016jx", offset,
+    std::fprintf(f, "    [+%3d](0x%p) 0x%016jx", offset,
         reinterpret_cast<const void *>(&uints[j]),
         static_cast<std::uintmax_t>(uints[j]));
     if (offset == offsetof(DerivedType, binding_)) {
       std::fputs(" <-- binding_\n", f);
     } else if (offset == offsetof(DerivedType, name_)) {
       std::fputs(" <-- name_\n", f);
     } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
       std::fputs(" <-- sizeInBytes_\n", f);
-    } else if (offset == offsetof(DerivedType, parent_)) {
-      std::fputs(" <-- parent_\n", f);
     } else if (offset == offsetof(DerivedType, uninstantiated_)) {
       std::fputs(" <-- uninstantiated_\n", f);
     } else if (offset == offsetof(DerivedType, typeHash_)) {
       std::fputs(" <-- typeHash_\n", f);
     } else if (offset == offsetof(DerivedType, kindParameter_)) {
       std::fputs(" <-- kindParameter_\n", f);
     } else if (offset == offsetof(DerivedType, lenParameterKind_)) {
       std::fputs(" <-- lenParameterKind_\n", f);
     } else if (offset == offsetof(DerivedType, component_)) {
       std::fputs(" <-- component_\n", f);
     } else if (offset == offsetof(DerivedType, procPtr_)) {
       std::fputs(" <-- procPtr_\n", f);
     } else if (offset == offsetof(DerivedType, special_)) {
       std::fputs(" <-- special_\n", f);
+    } else if (offset == offsetof(DerivedType, special_)) {
+      std::fputs(" <-- special_\n", f);
+    } else if (offset == offsetof(DerivedType, hasParent_)) {
+      std::fputs(
+          " <-- hasParent_, noInitializationNeeded_, noDestructionNeeded_\n",
+          f);
     } else {
       std::fputc('\n', f);
     }
   }
   std::fputs("  name: ", f);
   DumpScalarCharacter(f, name(), "DerivedType::name");
   const Descriptor &bindingDesc{binding()};
   std::fprintf(
if (genre_ == Genre::Data) {
     std::fputs("    Allocatable", f);
   } else if (genre_ == Genre::Automatic) {
     std::fputs("    Automatic  ", f);
   } else {
     std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
   }
   std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
       kind_, rank_, static_cast<std::size_t>(offset_));
+  if (initialization_) {
+    std::fprintf(f, " initialization @ 0x%p:\n", initialization_);
+    for (int j{0}; j < 128; j += sizeof(std::uint64_t)) {
+      std::fprintf(f, " [%3d] 0x%016jx\n", j,
+          static_cast<std::uintmax_t>(
+              *reinterpret_cast<const std::uint64_t *>(initialization_ + j)));
+    }
+  }
   return f;
 }
 
 FILE *SpecialBinding::Dump(FILE *f) const {
   std::fprintf(
       f, "SpecialBinding @ 0x%p:\n", reinterpret_cast<const void *>(this));
   switch (which_) {
   case Which::Assignment:
case Which::WriteUnformatted:
     std::fputs("    WriteUnformatted", f);
     break;
   default:
     std::fprintf(
         f, "    Unknown which: 0x%x", static_cast<std::uint8_t>(which_));
     break;
   }
   std::fprintf(f, "\n    rank: %d\n", rank_);
-  std::fprintf(f, "    isArgDescriptoSetr: 0x%x\n", isArgDescriptorSet_);
+  std::fprintf(f, "    isArgDescriptorSet: 0x%x\n", isArgDescriptorSet_);
   std::fprintf(f, "    proc: 0x%p\n", reinterpret_cast<void *>(proc_));
   return f;
 }
 
 } // namespace Fortran::runtime::typeInfo

flang/test/Semantics/call10.f90

pure subroutine s04(a) ! C1588
     !ERROR: An INTENT(OUT) dummy argument of a pure subroutine may not have a polymorphic ultimate component
     type(polyAlloc), intent(out) :: a
   end subroutine
   pure subroutine s05 ! C1589
     !ERROR: A pure subprogram may not have a variable with the SAVE attribute
     real, save :: v1
     !ERROR: A pure subprogram may not have a variable with the SAVE attribute
     real :: v2 = 0.
-    !TODO: once we have DATA: !ERROR: A pure subprogram may not have a variable with the SAVE attribute
+    !ERROR: A pure subprogram may not have a variable with the SAVE attribute
     real :: v3
     data v3/0./
     !ERROR: A pure subprogram may not have a variable with the SAVE attribute
     real :: v4
     common /blk/ v4
     save /blk/
     block
     !ERROR: A pure subprogram may not have a variable with the SAVE attribute

flang/test/Semantics/offsets01.f90

type :: t1(l)
     integer, len :: l
     real :: a(l)
   end type
   type :: t2(l1, l2)
     integer, len :: l1
     integer, len :: l2
     real :: b(l1, l2)
   end type
-  type(t1(n))   :: x1 !CHECK: x1 size=40 offset=
-  type(t2(n,n)) :: x2 !CHECK: x2 size=48 offset=
+  type(t1(n))   :: x1 !CHECK: x1 size=48 offset=
+  type(t2(n,n)) :: x2 !CHECK: x2 size=56 offset=
   !CHECK: a size=48 offset=0:
   !CHECK: b size=72 offset=0:
 end

flang/test/Semantics/typeinfo01.f90

 !RUN: %flang_fc1 -fdebug-dump-symbols %s | FileCheck %s
 ! Tests for derived type runtime descriptions
 
 module m01
   type :: t1
     integer :: n
   end type
 !CHECK: Module scope: m01
 !CHECK: .c.t1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.n,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
-!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL())
+!CHECK: .dt.t1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t1,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
 !CHECK: .n.t1, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"t1"
 !CHECK: DerivedType scope: t1
 end module
 
 module m02
   type :: parent
     integer :: pn
   end type
   type, extends(parent) :: child
     integer :: cn
   end type
 !CHECK: .c.child, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:1_8 init:[component::component(name=.n.parent,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.parent,lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.cn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=4_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
 !CHECK: .c.parent, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.pn,genre=1_1,category=0_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
-!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,parent=.dt.parent,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL())
-!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL())
+!CHECK: .dt.child, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.child,sizeinbytes=8_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.child,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
+!CHECK: .dt.parent, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.parent,sizeinbytes=4_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.parent,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 end module
 
 module m03
   type :: kpdt(k)
     integer(kind=1), kind :: k = 1
     real(kind=k) :: a
   end type
   type(kpdt(4)) :: x
 !CHECK: .c.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.a,genre=1_1,category=1_1,kind=4_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
-!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,parent=NULL(),uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
-!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,parent=NULL(),uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL())
+!CHECK: .dt.kpdt, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.kpdt,uninstantiated=NULL(),kindparameter=.kp.kpdt,lenparameterkind=NULL())
+!CHECK: .dt.kpdt.0, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.kpdt,sizeinbytes=4_8,uninstantiated=.dt.kpdt,kindparameter=.kp.kpdt.0,lenparameterkind=NULL(),component=.c.kpdt.0,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .kp.kpdt, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::1_8]
 !CHECK: .kp.kpdt.0, SAVE, TARGET: ObjectEntity type: INTEGER(8) shape: 0_8:0_8 init:[INTEGER(8)::4_8]
 end module
 
 module m04
   type :: tbps
    contains
     procedure :: b2 => s1
     procedure :: b1 => s1
   end type
  contains
   subroutine s1(x)
     class(tbps), intent(in) :: x
   end subroutine
-!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL())
+!CHECK: .dt.tbps, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.tbps,name=.n.tbps,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .v.tbps, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:1_8 init:[binding::binding(proc=s1,name=.n.b1),binding(proc=s1,name=.n.b2)]
 end module
 
 module m05
   type :: t
     procedure(s1), pointer :: p1 => s1
   end type
  contains
   subroutine s1(x)
     class(t), intent(in) :: x
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL())
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=24_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=.p.t,special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=1_1)
 !CHECK: .p.t, SAVE, TARGET: ObjectEntity type: TYPE(procptrcomponent) shape: 0_8:0_8 init:[procptrcomponent::procptrcomponent(name=.n.p1,offset=0_8,initialization=s1)]
 end module
 
 module m06
   type :: t
    contains
     procedure :: s1
     generic :: assignment(=) => s1
   end type
   type, extends(t) :: t2
    contains
     procedure :: s1 => s2 ! override
   end type
  contains
   subroutine s1(x, y)
     class(t), intent(out) :: x
     class(t), intent(in) :: y
   end subroutine
   subroutine s2(x, y)
     class(t2), intent(out) :: x
     class(t), intent(in) :: y
   end subroutine
 !CHECK: .c.t2, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:0_8 init:[component::component(name=.n.t,genre=1_1,category=5_1,kind=0_1,rank=0_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=.dt.t,lenvalue=NULL(),bounds=NULL(),initialization=NULL())]
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
-!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,parent=.dt.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL())
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
+!CHECK: .dt.t2, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t2,name=.n.t2,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=.c.t2,procptr=NULL(),special=NULL(),hasparent=1_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=4_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 !CHECK: .v.t2, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s2,name=.n.s1)]
 end module
 
 module m07
   type :: t
    contains
     procedure :: s1
     generic :: assignment(=) => s1
   end type
  contains
   impure elemental subroutine s1(x, y)
     class(t), intent(out) :: x
     class(t), intent(in) :: y
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:0_8 init:[specialbinding::specialbinding(which=5_1,rank=0_1,isargdescriptorset=3_1,proc=s1)]
 !CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:0_8 init:[binding::binding(proc=s1,name=.n.s1)]
 end module
 
 module m08
   type :: t
    contains
     final :: s1, s2, s3
   end type
  contains
   subroutine s1(x)
     type(t) :: x(:)
   end subroutine
   subroutine s2(x)
     type(t) :: x(3,3)
   end subroutine
   impure elemental subroutine s3(x)
     type(t) :: x
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=0_1)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:2_8 init:[specialbinding::specialbinding(which=8_1,rank=1_1,isargdescriptorset=1_1,proc=s1),specialbinding(which=8_1,rank=2_1,isargdescriptorset=0_1,proc=s2),specialbinding(which=9_1,rank=0_1,isargdescriptorset=0_1,proc=s3)]
 end module
 
 module m09
   type :: t
    contains
     procedure :: rf, ru, wf, wu
     generic :: read(formatted) => rf
subroutine wf(x,u,iot,v,iostat,iomsg)
     character(len=*), intent(inout) :: iomsg
   end subroutine
   subroutine wu(x,u,iostat,iomsg)
     class(t), intent(in) :: x
     integer, intent(in) :: u
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=1_1,proc=wu)]
 !CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
 end module
 
 module m10
   type, bind(c) :: t ! non-extensible
   end type
   interface read(formatted)
subroutine wf(x,u,iot,v,iostat,iomsg)
     character(len=*), intent(inout) :: iomsg
   end subroutine
   subroutine wu(x,u,iostat,iomsg)
     type(t), intent(in) :: x
     integer, intent(in) :: u
     integer, intent(out) :: iostat
     character(len=*), intent(inout) :: iomsg
   end subroutine
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=0_8,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t,hasparent=0_1,noinitializationneeded=1_1,nodestructionneeded=1_1)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=0_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=0_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=0_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=0_1,proc=wu)]
 end module
 
 module m11
   real, target :: target
   type :: t(len)
     integer(kind=8), len :: len
     real, allocatable :: allocatable(:)
     real, pointer :: pointer => target
     character(len=len) :: chauto
     real :: automatic(len)
   end type
-!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
+!CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(name=.n.t,uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=.lpk.t)
 !CHECK: .lpk.t, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
  contains
   subroutine s1(x)
 !CHECK: .b.t.1.automatic, SAVE, TARGET: ObjectEntity type: TYPE(value) shape: 0_8:1_8,0_8:0_8 init:reshape([value::value(genre=2_1,value=1_8),value(genre=3_1,value=0_8)],shape=[2,1])
-!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=target),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
-!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,parent=NULL(),uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL())
+!CHECK: .c.t.1, SAVE, TARGET: ObjectEntity type: TYPE(component) shape: 0_8:3_8 init:[component::component(name=.n.allocatable,genre=3_1,category=1_1,kind=4_1,rank=1_1,offset=0_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.pointer,genre=2_1,category=1_1,kind=4_1,rank=0_1,offset=48_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=.di.t.1.pointer),component(name=.n.chauto,genre=4_1,category=3_1,kind=1_1,rank=0_1,offset=72_8,characterlen=value(genre=3_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=NULL(),initialization=NULL()),component(name=.n.automatic,genre=4_1,category=1_1,kind=4_1,rank=1_1,offset=96_8,characterlen=value(genre=1_1,value=0_8),derived=NULL(),lenvalue=NULL(),bounds=.b.t.1.automatic,initialization=NULL())]
+!CHECK: .di.t.1.pointer, SAVE, TARGET: ObjectEntity type: TYPE(.dp.t.1.pointer) init:.dp.t.1.pointer(pointer=target)
+!CHECK: .dp.t.1.pointer: DerivedType components: pointer
+!CHECK: .dt.t.1, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=NULL(),name=.n.t,sizeinbytes=144_8,uninstantiated=.dt.t,kindparameter=NULL(),lenparameterkind=.lpk.t.1,component=.c.t.1,procptr=NULL(),special=NULL(),hasparent=0_1,noinitializationneeded=0_1,nodestructionneeded=0_1)
 !CHECK: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
+!CHECK: DerivedType scope: .dp.t.1.pointer size=24 alignment=8 instantiation of .dp.t.1.pointer
+!CHECK: pointer, POINTER size=24 offset=0: ObjectEntity type: REAL(4)
     type(t(*)), intent(in) :: x
   end subroutine
 end module
 
 module m12
   type :: t1
     integer :: n
     integer :: n2
     integer :: n_3
     ! CHECK: .n.n, SAVE, TARGET: ObjectEntity type: CHARACTER(1_8,1) init:"n"
     ! CHECK: .n.n2, SAVE, TARGET: ObjectEntity type: CHARACTER(2_8,1) init:"n2"
     ! CHECK: .n.n_3, SAVE, TARGET: ObjectEntity type: CHARACTER(3_8,1) init:"n_3"
   end type
 end module