[flang] Runtime implementation for default derived type formatted I/O

[klausler]

Summary

This is *not* user-defined derived type I/O, but rather Fortran's
built-in capabilities for using derived type data in I/O lists
and NAMELIST groups.

This feature depends on having the derived type description tables
that are created by Semantics available, passed through compilation
as initialized static objects to which pointers can be targeted
in the descriptors of I/O list items and NAMELIST groups.

NAMELIST processing now handles component references on input
(e.g., "&GROUP x%component = 123 /").

The C++ perspectives of the derived type information records
were transformed into proper classes when it was necessary to add
member functions to them.

The code in Semantics that generates derived type information
was changed to emit derived type components in component order,
not alphabetic order.

[jeanPerier]

LGTM

flang/include/flang/Semantics/runtime-type-info.h

 
 struct RuntimeDerivedTypeTables {
   Scope *schemata{nullptr};
   std::set<std::string> names;
 };
 
 RuntimeDerivedTypeTables BuildRuntimeDerivedTypeTables(SemanticsContext &);
 
-void Dump(llvm::raw_ostream &, const RuntimeDerivedTypeTables &);
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_RUNTIME_TYPE_INFO_H_

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

const Symbol *RuntimeTableBuilder::DescribeType(Scope &dtScope) {
   AddValue(dtValues, derivedTypeSchema_, "kindparameter"s,
       SaveNumericPointerTarget<Int8>(
           scope, SaveObjectName(".kp."s + distinctName), std::move(kinds)));
   AddValue(dtValues, derivedTypeSchema_, "lenparameterkind"s,
       SaveNumericPointerTarget<Int1>(
           scope, SaveObjectName(".lpk."s + distinctName), std::move(lenKinds)));
   // Traverse the components of the derived type
   if (!isPDTdefinition) {
-    std::vector<evaluate::StructureConstructor> dataComponents;
+    std::vector<const Symbol *> dataComponentSymbols;
     std::vector<evaluate::StructureConstructor> procPtrComponents;
     std::vector<evaluate::StructureConstructor> specials;
     for (const auto &pair : dtScope) {
       const Symbol &symbol{*pair.second};
       auto locationRestorer{common::ScopedSet(location_, symbol.name())};
       std::visit(
           common::visitors{
               [&](const TypeParamDetails &) {
                 // already handled above in declaration order
               },
-              [&](const ObjectEntityDetails &object) {
-                dataComponents.emplace_back(DescribeComponent(
-                    symbol, object, scope, dtScope, distinctName, parameters));
+              [&](const ObjectEntityDetails &) {
+                dataComponentSymbols.push_back(&symbol);
               },
               [&](const ProcEntityDetails &proc) {
                 if (IsProcedurePointer(symbol)) {
                   procPtrComponents.emplace_back(
                       DescribeComponent(symbol, proc, scope));
                 }
               },
               [&](const ProcBindingDetails &) { // handled in a later pass
               },
               [&](const GenericDetails &generic) {
                 DescribeGeneric(generic, specials);
               },
               [&](const auto &) {
                 common::die(
                     "unexpected details on symbol '%s' in derived type scope",
                     symbol.name().ToString().c_str());
               },
           },
           symbol.details());
     }
+    // Sort the data component symbols by offset before emitting them
+    std::sort(dataComponentSymbols.begin(), dataComponentSymbols.end(),
+        [](const Symbol *x, const Symbol *y) {
+          return x->offset() < y->offset();
+        });
+    std::vector<evaluate::StructureConstructor> dataComponents;
+    for (const Symbol *symbol : dataComponentSymbols) {
+      auto locationRestorer{common::ScopedSet(location_, symbol->name())};
+      dataComponents.emplace_back(
+          DescribeComponent(*symbol, symbol->get<ObjectEntityDetails>(), scope,
+              dtScope, distinctName, parameters));
+    }
     AddValue(dtValues, derivedTypeSchema_, "component"s,
         SaveDerivedPointerTarget(scope, SaveObjectName(".c."s + distinctName),
             std::move(dataComponents),
             evaluate::ConstantSubscripts{
                 static_cast<evaluate::ConstantSubscript>(
                     dataComponents.size())}));
     AddValue(dtValues, derivedTypeSchema_, "procptr"s,
         SaveDerivedPointerTarget(scope, SaveObjectName(".p."s + distinctName),

flang/runtime/CMakeLists.txt

add_flang_library(FortranRuntime
   stat.cpp
   stop.cpp
   sum.cpp
   terminator.cpp
   time-intrinsic.cpp
   tools.cpp
   transformational.cpp
   type-code.cpp
+  type-info.cpp
   unit.cpp
   unit-map.cpp
 
   LINK_LIBS
   FortranDecimal
 )

flang/runtime/copy.cpp

void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
   char *toPtr{to.Element<char>(toAt)};
   const char *fromPtr{from.Element<const char>(fromAt)};
   RUNTIME_CHECK(terminator, to.ElementBytes() == from.ElementBytes());
   std::memcpy(toPtr, fromPtr, to.ElementBytes());
   if (const auto *addendum{to.Addendum()}) {
     if (const auto *derived{addendum->derivedType()}) {
       RUNTIME_CHECK(terminator,
           from.Addendum() && derived == from.Addendum()->derivedType());
-      const Descriptor &componentDesc{derived->component.descriptor()};
+      const Descriptor &componentDesc{derived->component()};
       const typeInfo::Component *component{
           componentDesc.OffsetElement<typeInfo::Component>()};
       std::size_t nComponents{componentDesc.Elements()};
       for (std::size_t j{0}; j < nComponents; ++j, ++component) {
-        if (component->genre == typeInfo::Component::Genre::Allocatable ||
-            component->genre == typeInfo::Component::Genre::Automatic) {
+        if (component->genre() == typeInfo::Component::Genre::Allocatable ||
+            component->genre() == typeInfo::Component::Genre::Automatic) {
           Descriptor &toDesc{
-              *reinterpret_cast<Descriptor *>(toPtr + component->offset)};
+              *reinterpret_cast<Descriptor *>(toPtr + component->offset())};
           if (toDesc.raw().base_addr != nullptr) {
             toDesc.set_base_addr(nullptr);
             RUNTIME_CHECK(terminator, toDesc.Allocate() == CFI_SUCCESS);
             const Descriptor &fromDesc{*reinterpret_cast<const Descriptor *>(
-                fromPtr + component->offset)};
+                fromPtr + component->offset())};
             CopyArray(toDesc, fromDesc, terminator);
           }
         }
       }
     }
   }
 }
 

flang/runtime/derived.cpp

 #include "descriptor.h"
 #include "type-info.h"
 
 namespace Fortran::runtime {
 
 static const typeInfo::SpecialBinding *FindFinal(
     const typeInfo::DerivedType &derived, int rank) {
   const typeInfo::SpecialBinding *elemental{nullptr};
-  const Descriptor &specialDesc{derived.special.descriptor()};
+  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)};
     switch (special.which) {
     case typeInfo::SpecialBinding::Which::Final:
       if (special.rank == rank) {
         return &special;
if (const auto *special{FindFinal(derived, descriptor.rank())}) {
     } else {
       // Finalizable objects must be contiguous.
       auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
       p(descriptor.OffsetElement<char>());
     }
   }
 }
 
-static inline SubscriptValue GetValue(
-    const typeInfo::Value &value, const Descriptor &descriptor) {
-  if (value.genre == typeInfo::Value::Genre::LenParameter) {
-    return descriptor.Addendum()->LenParameterValue(value.value);
-  } else {
-    return value.value;
-  }
-}
-
 // 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.descriptor()};
-  std::int64_t myComponents{componentDesc.GetDimension(0).Extent()};
+  const Descriptor &componentDesc{derived.component()};
+  auto myComponents{static_cast<SubscriptValue>(componentDesc.Elements())};
   std::size_t elements{descriptor.Elements()};
   std::size_t byteStride{descriptor.ElementBytes()};
   for (unsigned 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) {
+    if (comp.genre() == typeInfo::Component::Genre::Allocatable ||
+        comp.genre() == typeInfo::Component::Genre::Automatic) {
       for (std::size_t j{0}; j < elements; ++j) {
-        descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset)
+        descriptor.OffsetElement<Descriptor>(j * byteStride + comp.offset())
             ->Deallocate(finalize);
       }
-    } else if (comp.genre == typeInfo::Component::Genre::Data &&
-        comp.derivedType.descriptor().raw().base_addr) {
+    } else if (comp.genre() == typeInfo::Component::Genre::Data &&
+        comp.derivedType()) {
       SubscriptValue extent[maxRank];
-      const Descriptor &boundsDesc{comp.bounds.descriptor()};
-      for (int dim{0}; dim < comp.rank; ++dim) {
-        extent[dim] =
-            GetValue(
-                *boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(2 * dim),
-                descriptor) -
-            GetValue(*boundsDesc.ZeroBasedIndexedElement<typeInfo::Value>(
-                         2 * dim + 1),
-                descriptor) +
-            1;
+      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 auto &compType{*comp.derivedType.descriptor()
-                                .OffsetElement<typeInfo::DerivedType>()};
+      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);
+            descriptor.OffsetElement<char>(j * byteStride + comp.offset()),
+            comp.rank(), extent);
         Destroy(compDesc, finalize, compType);
       }
     }
   }
-  const Descriptor &parentDesc{derived.parent.descriptor()};
+  const Descriptor &parentDesc{derived.parent()};
   if (const auto *parent{parentDesc.OffsetElement<typeInfo::DerivedType>()}) {
     Destroy(descriptor, finalize, *parent);
   }
 }
 } // namespace Fortran::runtime

flang/runtime/descriptor-io.h

 // Implementation of I/O data list item transfers based on descriptors.
 
 #include "cpp-type.h"
 #include "descriptor.h"
 #include "edit-input.h"
 #include "edit-output.h"
 #include "io-stmt.h"
 #include "terminator.h"
+#include "type-info.h"
 #include "flang/Common/uint128.h"
 
 namespace Fortran::runtime::io::descr {
 template <typename A>
 inline A &ExtractElement(IoStatementState &io, const Descriptor &descriptor,
     const SubscriptValue subscripts[]) {
   A *p{descriptor.Element<A>(subscripts)};
   if (!p) {
-    io.GetIoErrorHandler().Crash("ExtractElement: subscripts out of range");
+    io.GetIoErrorHandler().Crash(
+        "ExtractElement: null base address or subscripts out of range");
   }
   return *p;
 }
 
 // Per-category descriptor-based I/O templates
 
 // TODO (perhaps as a nontrivial but small starter project): implement
 // automatic repetition counts, like "10*3.14159", for list-directed and
if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
       io.GetIoErrorHandler().Crash(
           "FormattedLogicalIO: subscripts out of bounds");
     }
   }
   return true;
 }
 
 template <Direction DIR>
+static bool DescriptorIO(IoStatementState &, const Descriptor &);
+
+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(
+        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);
+    const Descriptor &compDesc{*reinterpret_cast<const Descriptor *>(pointer)};
+    return DescriptorIO<DIR>(io, compDesc);
+  }
+}
+
+template <Direction DIR>
+static bool FormattedDerivedTypeIO(
+    IoStatementState &io, const Descriptor &descriptor) {
+  Terminator &terminator{io.GetIoErrorHandler()};
+  const DescriptorAddendum *addendum{descriptor.Addendum()};
+  RUNTIME_CHECK(terminator, addendum != nullptr);
+  const typeInfo::DerivedType *type{addendum->derivedType()};
+  RUNTIME_CHECK(terminator, type != nullptr);
+  if (false) {
+    // TODO: user-defined derived type formatted I/O
+  } else {
+    // Default derived type formatting
+    const Descriptor &compArray{type->component()};
+    RUNTIME_CHECK(terminator, compArray.rank() == 1);
+    std::size_t numComponents{compArray.Elements()};
+    std::size_t numElements{descriptor.Elements()};
+    SubscriptValue subscripts[maxRank];
+    descriptor.GetLowerBounds(subscripts);
+    for (std::size_t j{0}; j < numElements;
+         ++j, descriptor.IncrementSubscripts(subscripts)) {
+      SubscriptValue at[maxRank];
+      compArray.GetLowerBounds(at);
+      for (std::size_t k{0}; k < numComponents;
+           ++k, compArray.IncrementSubscripts(at)) {
+        const typeInfo::Component &component{
+            *compArray.Element<typeInfo::Component>(at)};
+        if (!DefaultFormattedComponentIO<DIR>(
+                io, component, descriptor, subscripts, terminator)) {
+          return false;
+        }
+      }
+    }
+  }
+  return true;
+}
+
+template <Direction DIR>
 static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
   if (!io.get_if<IoDirectionState<DIR>>()) {
     io.GetIoErrorHandler().Crash(
         "DescriptorIO() called for wrong I/O direction");
     return false;
   }
   if constexpr (DIR == Direction::Input) {
     if (!io.BeginReadingRecord()) {
       return false;
     }
   }
   if (auto *unf{io.get_if<UnformattedIoStatementState<DIR>>()}) {
     std::size_t elementBytes{descriptor.ElementBytes()};
     SubscriptValue subscripts[maxRank];
     descriptor.GetLowerBounds(subscripts);
     std::size_t numElements{descriptor.Elements()};
-    if (descriptor.IsContiguous()) { // contiguous unformatted I/O
+    if (false) {
+      // TODO: user-defined derived type unformatted I/O
+    } else if (descriptor.IsContiguous()) { // contiguous unformatted I/O
       char &x{ExtractElement<char>(io, descriptor, subscripts)};
       auto totalBytes{numElements * elementBytes};
       if constexpr (DIR == Direction::Output) {
         return unf->Emit(&x, totalBytes, elementBytes);
       } else {
         return unf->Receive(&x, totalBytes, elementBytes);
       }
     } else { // non-contiguous unformatted I/O
case TypeCategory::Logical:
             io, descriptor);
       default:
         io.GetIoErrorHandler().Crash(
             "DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor",
             kind);
         return false;
       }
     case TypeCategory::Derived:
-      io.GetIoErrorHandler().Crash(
-          "DescriptorIO: Unimplemented: derived type I/O",
-          static_cast<int>(descriptor.type().raw()));
-      return false;
+      return FormattedDerivedTypeIO<DIR>(io, descriptor);
     }
   }
   io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor",
       static_cast<int>(descriptor.type().raw()));
   return false;
 }
 } // namespace Fortran::runtime::io::descr
 #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_

flang/runtime/descriptor.h

public:
   const std::uint64_t &flags() const { return flags_; }
 
   std::size_t LenParameters() const;
 
   typeInfo::TypeParameterValue LenParameterValue(int which) const {
     return len_[which];
   }
   static constexpr std::size_t SizeInBytes(int lenParameters) {
-    return sizeof(DescriptorAddendum) - sizeof(typeInfo::TypeParameterValue) +
-        lenParameters * sizeof(typeInfo::TypeParameterValue);
+    // TODO: Don't waste that last word if lenParameters == 0
+    return sizeof(DescriptorAddendum) +
+        std::max(lenParameters - 1, 0) * sizeof(typeInfo::TypeParameterValue);
   }
   std::size_t SizeInBytes() const;
 
   void SetLenParameterValue(int which, typeInfo::TypeParameterValue x) {
     len_[which] = x;
   }
 
   void Dump(FILE * = stdout) const;

flang/runtime/descriptor.cpp

void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
   // Subtle: the standard CFI_establish() function doesn't allow a zero
   // elem_len argument in cases where elem_len is not ignored; and when it
   // returns an error code (CFI_INVALID_ELEM_LEN in this case), it must not
   // modify the descriptor.  That design makes sense, maybe, for actual
   // C interoperability, but we need to work around it here.  A zero
   // incoming element length is replaced by 4 so that it will be valid
   // for all CHARACTER kinds.
   std::size_t workaroundElemLen{elementBytes ? elementBytes : 4};
-  RUNTIME_CHECK(terminator,
-      ISO::CFI_establish(&raw_, p, attribute, t.raw(), workaroundElemLen, rank,
-          extent) == CFI_SUCCESS);
+  int cfiStatus{ISO::CFI_establish(
+      &raw_, p, attribute, t.raw(), workaroundElemLen, rank, extent)};
+  if (cfiStatus != CFI_SUCCESS) {
+    terminator.Crash(
+        "Descriptor::Establish: CFI_establish returned %d", cfiStatus, t.raw());
+  }
   if (elementBytes == 0) {
     raw_.elem_len = 0;
     for (int j{0}; j < rank; ++j) {
       GetDimension(j).SetByteStride(0);
     }
   }
   raw_.f18Addendum = addendum;
   DescriptorAddendum *a{Addendum()};
void Descriptor::Establish(int characterKind, std::size_t characters, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {
   Establish(TypeCode{TypeCategory::Character, characterKind},
       characterKind * characters, p, rank, extent, attribute, addendum);
 }
 
 void Descriptor::Establish(const typeInfo::DerivedType &dt, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  Establish(CFI_type_struct, dt.sizeInBytes, p, rank, extent, attribute, true);
+  Establish(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
+      extent, attribute, true);
   DescriptorAddendum *a{Addendum()};
   Terminator terminator{__FILE__, __LINE__};
   RUNTIME_CHECK(terminator, a != nullptr);
   new (a) DescriptorAddendum{&dt};
 }
 
 OwningPtr<Descriptor> Descriptor::Create(TypeCode t, std::size_t elementBytes,
     void *p, int rank, const SubscriptValue *extent,
OwningPtr<Descriptor> Descriptor::Create(int characterKind,
     ISO::CFI_attribute_t attribute) {
   return Create(TypeCode{TypeCategory::Character, characterKind},
       characterKind * characters, p, rank, extent, attribute);
 }
 
 OwningPtr<Descriptor> Descriptor::Create(const typeInfo::DerivedType &dt,
     void *p, int rank, const SubscriptValue *extent,
     ISO::CFI_attribute_t attribute) {
-  return Create(TypeCode{CFI_type_struct}, dt.sizeInBytes, p, rank, extent,
-      attribute, dt.LenParameters());
+  return Create(TypeCode{TypeCategory::Derived, 0}, dt.sizeInBytes(), p, rank,
+      extent, attribute, dt.LenParameters());
 }
 
 std::size_t Descriptor::SizeInBytes() const {
   const DescriptorAddendum *addendum{Addendum()};
   return sizeof *this - sizeof(Dimension) + raw_.rank * sizeof(Dimension) +
       (addendum ? addendum->SizeInBytes() : 0);
 }
 

flang/runtime/namelist.cpp

 #include "descriptor-io.h"
 #include "io-api.h"
 #include "io-stmt.h"
 #include <cstring>
 #include <limits>
 
 namespace Fortran::runtime::io {
 
+// Max size of a group, symbol or component identifier that can appear in
+// NAMELIST input, plus a byte for NUL termination.
+static constexpr std::size_t nameBufferSize{201};
+
 bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
   IoStatementState &io{*cookie};
   io.CheckFormattedStmtType<Direction::Output>("OutputNamelist");
   ConnectionState &connection{io.GetConnectionState()};
   connection.modes.inNamelist = true;
   // Internal functions to advance records and convert case
   const auto EmitWithAdvance{[&](char ch) -> bool {
     return (!connection.NeedAdvance(1) || io.AdvanceRecord()) &&
if (!(EmitWithAdvance(j == 0 ? ' ' : ',') && EmitUpperCase(item.name) &&
             descr::DescriptorIO<Direction::Output>(io, item.descriptor))) {
       return false;
     }
   }
   // terminal /
   return EmitWithAdvance('/');
 }
 
+static constexpr bool IsLegalIdStart(char32_t ch) {
+  return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' ||
+      ch == '@' || ch == '$';
+}
+
+static constexpr bool IsLegalIdChar(char32_t ch) {
+  return IsLegalIdStart(ch) || (ch >= '0' && ch <= '9');
+}
+
+static constexpr char NormalizeIdChar(char32_t ch) {
+  return static_cast<char>(ch >= 'A' && ch <= 'Z' ? ch - 'A' + 'a' : ch);
+}
+
 static bool GetLowerCaseName(
     IoStatementState &io, char buffer[], std::size_t maxLength) {
-  if (auto ch{io.GetCurrentChar()}) {
-    static const auto IsLegalIdStart{[](char32_t ch) -> bool {
-      return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') ||
-          ch == '_' || ch == '@' || ch == '$';
-    }};
+  if (auto ch{io.GetNextNonBlank()}) {
     if (IsLegalIdStart(*ch)) {
       std::size_t j{0};
       do {
-        buffer[j] =
-            static_cast<char>(*ch >= 'A' && *ch <= 'Z' ? *ch - 'A' + 'a' : *ch);
+        buffer[j] = NormalizeIdChar(*ch);
         io.HandleRelativePosition(1);
         ch = io.GetCurrentChar();
-      } while (++j < maxLength && ch &&
-          (IsLegalIdStart(*ch) || (*ch >= '0' && *ch <= '9')));
+      } while (++j < maxLength && ch && IsLegalIdChar(*ch));
       buffer[j++] = '\0';
       if (j <= maxLength) {
         return true;
       }
       io.GetIoErrorHandler().SignalError(
           "Identifier '%s...' in NAMELIST input group is too long", buffer);
     }
   }
static std::optional<SubscriptValue> GetSubscriptValue(IoStatementState &io) {
   }
   return value;
 }
 
 static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
     const Descriptor &source, const char *name) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   io.HandleRelativePosition(1); // skip '('
-  // Allow for blanks in subscripts; it's nonstandard, but not ambiguous
-  // within the parentheses
+  // Allow for blanks in subscripts; they're nonstandard, but not
+  // ambiguous within the parentheses.
   SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank];
   int j{0};
   std::size_t elemLen{source.ElementBytes()};
   bool ok{true};
   std::optional<char32_t> ch{io.GetNextNonBlank()};
   for (; ch && *ch != ')'; ++j) {
     SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0};
     if (j < maxRank && j < source.rank()) {
if (ch && *ch == ')') {
       handler.SignalError(
           "Bad subscripts (missing ')') for NAMELIST input group item '%s'",
           name);
     }
   }
   return false;
 }
 
+static bool HandleComponent(IoStatementState &io, Descriptor &desc,
+    const Descriptor &source, const char *name) {
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  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);
+        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 {
+      handler.SignalError("NAMELIST component reference '%%%s' of input group "
+                          "item %s for non-derived type",
+          compName, name);
+    }
+  } else {
+    handler.SignalError("NAMELIST component reference of input group item %s "
+                        "has no name after '%'",
+        name);
+  }
+  return false;
+}
+
 bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   IoStatementState &io{*cookie};
   io.CheckFormattedStmtType<Direction::Input>("InputNamelist");
   ConnectionState &connection{io.GetConnectionState()};
   connection.modes.inNamelist = true;
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   // Check the group header
   std::optional<char32_t> next{io.GetNextNonBlank()};
   if (!next || *next != '&') {
     handler.SignalError(
         "NAMELIST input group does not begin with '&' (at '%lc')", *next);
     return false;
   }
   io.HandleRelativePosition(1);
-  char name[101];
+  char name[nameBufferSize];
   if (!GetLowerCaseName(io, name, sizeof name)) {
     handler.SignalError("NAMELIST input group has no name");
     return false;
   }
   RUNTIME_CHECK(handler, group.groupName != nullptr);
   if (std::strcmp(group.groupName, name) != 0) {
     handler.SignalError(
         "NAMELIST input group name '%s' is not the expected '%s'", name,
while (true) {
     // A copy of the descriptor is made if necessary.
     const Descriptor &itemDescriptor{group.item[itemIndex].descriptor};
     const Descriptor *useDescriptor{&itemDescriptor};
     StaticDescriptor<maxRank, true, 16> staticDesc[2];
     int whichStaticDesc{0};
     next = io.GetCurrentChar();
     if (next && (*next == '(' || *next == '%')) {
       do {
-        if (*next == '(') {
-          Descriptor &mutableDescriptor{
-              staticDesc[whichStaticDesc].descriptor()};
-          whichStaticDesc ^= 1;
+        Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()};
+        if (*next == '(') {
           HandleSubscripts(io, mutableDescriptor, *useDescriptor, name);
-          useDescriptor = &mutableDescriptor;
         } else {
-          handler.Crash("unimplemented: component references in NAMELIST");
+          HandleComponent(io, mutableDescriptor, *useDescriptor, name);
         }
+        useDescriptor = &mutableDescriptor;
         next = io.GetCurrentChar();
       } while (next && (*next == '(' || *next == '%'));
     }
     // Skip the '='
     next = io.GetNextNonBlank();
     if (!next || *next != '=') {
       handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'",
           name, group.groupName);

flang/runtime/tools.h

case TypeCategory::Logical:
     } else {
       return std::nullopt;
     }
   default:
     break;
   }
   return std::nullopt;
 }
+
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TOOLS_H_

flang/runtime/type-info.h

 
 // A C++ perspective of the derived type description schemata in
 // flang/module/__fortran_type_info.f90.
 
 #include "descriptor.h"
 #include "flang/Common/Fortran.h"
 #include <cinttypes>
 #include <memory>
+#include <optional>
 
 namespace Fortran::runtime::typeInfo {
 
+struct Component;
+
 class DerivedType {
 public:
-  ~DerivedType();
+  ~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(); }
+
+  std::size_t LenParameters() const { return lenParameterKind().Elements(); }
+
+  // Finds a data component by name in this derived type or tis ancestors.
+  const Component *FindDataComponent(
+      const char *name, std::size_t nameLen) 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
+      binding_; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
 
-  StaticDescriptor<0> name; // CHARACTER(:), POINTER
+  StaticDescriptor<0> name_; // CHARACTER(:), POINTER
 
-  std::uint64_t sizeInBytes{0};
-  StaticDescriptor<0, true> parent; // TYPE(DERIVEDTYPE), 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
+  StaticDescriptor<0, true> uninstantiated_; // TYPE(DERIVEDTYPE), POINTER
 
   // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
-  std::uint64_t typeHash{0};
+  std::uint64_t typeHash_{0};
 
   // These pointer targets include all of the items from the parent, if any.
-  StaticDescriptor<1> kindParameter; // pointer to rank-1 array of INTEGER(8)
-  StaticDescriptor<1> lenParameterKind; // pointer to rank-1 array of INTEGER(1)
+  StaticDescriptor<1> kindParameter_; // pointer to rank-1 array of INTEGER(8)
+  StaticDescriptor<1>
+      lenParameterKind_; // pointer to rank-1 array of INTEGER(1)
 
   // This array of local data components includes the parent component.
   // Components are in alphabetic order.
+  // TODO pmk: fix to be "component order"
   // It does not include procedure pointer components.
   StaticDescriptor<1, true>
-      component; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
+      component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
 
   // Procedure pointer components
   StaticDescriptor<1, true>
-      procPtr; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
+      procPtr_; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
 
   // Does not include special bindings from ancestral types.
   StaticDescriptor<1, true>
-      special; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
-
-  std::size_t LenParameters() const {
-    return lenParameterKind.descriptor().Elements();
-  }
+      special_; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
 };
 
 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
 
 struct Binding {
   ProcedurePointer proc;
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
 };
 
-struct Value {
+class Value {
+public:
   enum class Genre : std::uint8_t {
     Deferred = 1,
     Explicit = 2,
     LenParameter = 3
   };
-  Genre genre{Genre::Explicit};
+
+  std::optional<TypeParameterValue> GetValue(const Descriptor *) const;
+
+private:
+  Genre genre_{Genre::Explicit};
   // The value encodes an index into the table of LEN type parameters in
   // a descriptor's addendum for genre == Genre::LenParameter.
-  TypeParameterValue value{0};
+  TypeParameterValue value_{0};
 };
 
-struct Component {
-  enum class Genre : std::uint8_t { Data, Pointer, Allocatable, Automatic };
-  StaticDescriptor<0> name; // CHARACTER(:), POINTER
-  Genre genre{Genre::Data};
-  std::uint8_t category; // common::TypeCategory
-  std::uint8_t kind{0};
-  std::uint8_t rank{0};
-  std::uint64_t offset{0};
-  Value characterLen; // for TypeCategory::Character
-  StaticDescriptor<0, true> derivedType; // TYPE(DERIVEDTYPE), POINTER
+class Component {
+public:
+  enum class Genre : std::uint8_t {
+    Data = 1,
+    Pointer = 2,
+    Allocatable = 3,
+    Automatic = 4
+  };
+
+  const Descriptor &name() const { return name_.descriptor(); }
+  Genre genre() const { return genre_; }
+  TypeCategory category() const { return static_cast<TypeCategory>(category_); }
+  int kind() const { return kind_; }
+  int rank() const { return rank_; }
+  std::uint64_t offset() const { return offset_; }
+  const Value &characterLen() const { return characterLen_; }
+  const DerivedType *derivedType() const {
+    return derivedType_.descriptor().OffsetElement<const DerivedType>();
+  }
+  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,
+      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
+  std::uint8_t kind_{0};
+  std::uint8_t rank_{0};
+  std::uint64_t offset_{0};
+  Value characterLen_; // for TypeCategory::Character
+  StaticDescriptor<0, true> derivedType_; // TYPE(DERIVEDTYPE), POINTER
   StaticDescriptor<1, true>
-      lenValue; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
+      lenValue_; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
   StaticDescriptor<2, true>
-      bounds; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
-  char *initialization{nullptr}; // for Genre::Data and Pointer
+      bounds_; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
+  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

flang/runtime/type-info.cpp

+//===-- runtime/type-info.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 "type-info.h"
+#include "terminator.h"
+#include <cstdio>
+
+namespace Fortran::runtime::typeInfo {
+
+std::optional<TypeParameterValue> Value::GetValue(
+    const Descriptor *descriptor) const {
+  switch (genre_) {
+  case Genre::Explicit:
+    return value_;
+  case Genre::LenParameter:
+    if (descriptor) {
+      if (const auto *addendum{descriptor->Addendum()}) {
+        return addendum->LenParameterValue(value_);
+      }
+    }
+    return std::nullopt;
+  default:
+    return std::nullopt;
+  }
+}
+
+void Component::EstablishDescriptor(Descriptor &descriptor,
+    const Descriptor &container, const SubscriptValue subscripts[],
+    Terminator &terminator) const {
+  RUNTIME_CHECK(terminator, genre_ == Genre::Data);
+  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_) {
+    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();
+    }
+  }
+  descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
+}
+
+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;
+}
+
+static void DumpScalarCharacter(
+    FILE *f, const Descriptor &desc, const char *what) {
+  if (desc.raw().version == CFI_VERSION &&
+      desc.type() == TypeCode{TypeCategory::Character, 1} &&
+      desc.ElementBytes() > 0 && desc.rank() == 0 &&
+      desc.OffsetElement() != nullptr) {
+    std::fwrite(desc.OffsetElement(), desc.ElementBytes(), 1, f);
+  } else {
+    std::fprintf(f, "bad %s descriptor: ", what);
+    desc.Dump(f);
+  }
+}
+
+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,
+        reinterpret_cast<const void *>(&uints[j]),
+        static_cast<std::intmax_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 {
+      std::fputc('\n', f);
+    }
+  }
+  std::fputs("  name: ", f);
+  DumpScalarCharacter(f, name(), "DerivedType::name");
+  const Descriptor &bindingDesc{binding()};
+  std::fprintf(
+      f, "\n  binding descriptor (byteSize 0x%zx): ", binding_.byteSize);
+  bindingDesc.Dump(f);
+  const Descriptor &compDesc{component()};
+  std::fputs("\n  components:\n", f);
+  if (compDesc.raw().version == CFI_VERSION &&
+      compDesc.type() == TypeCode{TypeCategory::Derived, 0} &&
+      compDesc.ElementBytes() == sizeof(Component) && compDesc.rank() == 1) {
+    std::size_t n{compDesc.Elements()};
+    for (std::size_t j{0}; j < n; ++j) {
+      const Component &comp{*compDesc.ZeroBasedIndexedElement<Component>(j)};
+      std::fprintf(f, "  [%3zd] ", j);
+      comp.Dump(f);
+    }
+  } else {
+    std::fputs("    bad descriptor: ", f);
+    compDesc.Dump(f);
+  }
+  return f;
+}
+
+FILE *Component::Dump(FILE *f) const {
+  std::fprintf(f, "Component @ 0x%p:\n", reinterpret_cast<const void *>(this));
+  std::fputs("    name: ", f);
+  DumpScalarCharacter(f, name(), "Component::name");
+  switch (genre_) {
+  case Genre::Data:
+    std::fputs("    Data       ", f);
+    break;
+  case Genre::Pointer:
+    std::fputs("    Pointer    ", f);
+    break;
+  case Genre::Allocatable:
+    std::fputs("    Allocatable", f);
+    break;
+  case Genre::Automatic:
+    std::fputs("    Automatic  ", f);
+    break;
+  default:
+    std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
+    break;
+  }
+  std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
+      kind_, rank_, static_cast<std::size_t>(offset_));
+  return f;
+}
+
+} // namespace Fortran::runtime::typeInfo

flang/test/Semantics/typeinfo01.f90

 
 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.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()),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())]
+!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())
 end module
 
 module m03
   type :: kpdt(k)
     integer(kind=1), kind :: k = 1
type :: t(len)
     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: .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.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()),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.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)]
+!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: .lpk.t.1, SAVE, TARGET: ObjectEntity type: INTEGER(1) shape: 0_8:0_8 init:[INTEGER(1)::8_1]
     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