[flang] Implement user-defined derived type runtime I/O

With derived type description tables now available to the
runtime library, it is possible to implement the concept
of "child" I/O statements in the runtime and use them to
convert instances of derived type I/O data transfers into
calls to user-defined subroutines when they have been specified
for a type.  (See Fortran 2018, subclauses 12.6.4.8 & 13.7.6).

 - Support formatted, list-directed, and NAMELIST
   transfers to internal parent units; support these, and unformatted
   transfers, for external parent units.
 - Support nested child defined derived type I/O.
 - Parse DT'foo'(v-list) FORMAT data edit descriptors and passes
   their strings &/or v-list values as arguments to the defined
   formatted I/O routines.
 - Fix problems with this feature encountered in semantics and
   FORMAT valiation during development and end-to-end testing.
 - Convert typeInfo::SpecialBinding from a struct to a class
   after adding a member function.

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

flang/include/flang/Common/format.h

@@ -136,11 +136,11 @@ private:
   const CHAR *cursor_{}; // current location in format_
   const CHAR *laCursor_{}; // lookahead cursor
   Token token_{}; // current token
+  TokenKind previousTokenKind_{TokenKind::None};
   int64_t integerValue_{-1}; // value of UnsignedInteger token
   Token knrToken_{}; // k, n, or r UnsignedInteger token
   int64_t knrValue_{-1}; // -1 ==> not present
   int64_t wValue_{-1};
-  bool previousTokenWasInt_{false};
   char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name
   bool formatHasErrors_{false};
   bool unterminatedFormatError_{false};
@@ -179,7 +179,7 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
   // At entry, cursor_ points before the start of the next token.
   // At exit, cursor_ points to last CHAR of token_.
 
-  previousTokenWasInt_ = token_.kind() == TokenKind::UnsignedInteger;
+  previousTokenKind_ = token_.kind();
   CHAR c{NextChar()};
   token_.set_kind(TokenKind::None);
   token_.set_offset(cursor_ - format_);
@@ -416,7 +416,8 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
       }
     }
     SetLength();
-    if (stmt_ == IoStmtKind::Read) { // 13.3.2p6
+    if (stmt_ == IoStmtKind::Read &&
+        previousTokenKind_ != TokenKind::DT) { // 13.3.2p6
       ReportError("String edit descriptor in READ format expression");
     } else if (token_.kind() != TokenKind::String) {
       ReportError("Unterminated string");
@@ -829,7 +830,8 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
       // Possible first token of the next format item; token not yet processed.
       if (commaRequired) {
         const char *s{"Expected ',' or ')' in format expression"}; // C1302
-        if (previousTokenWasInt_ && itemsWithLeadingInts_.test(token_.kind())) {
+        if (previousTokenKind_ == TokenKind::UnsignedInteger &&
+            itemsWithLeadingInts_.test(token_.kind())) {
           ReportError(s);
         } else {
           ReportWarning(s);

flang/lib/Semantics/check-declarations.cpp

@@ -1797,9 +1797,15 @@ void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType,
 void CheckHelper::CheckDioDummyIsDerived(
     const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
   if (const DeclTypeSpec * type{arg.GetType()}) {
-    const DerivedTypeSpec *derivedType{type->AsDerived()};
+    if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
-    if (derivedType) {
       CheckAlreadySeenDefinedIo(derivedType, ioKind, subp);
+      bool isPolymorphic{type->IsPolymorphic()};
+      if (isPolymorphic != IsExtensibleType(derivedType)) {
+        messages_.Say(arg.name(),
+            "Dummy argument '%s' of a defined input/output procedure must be %s when the derived type is %s"_err_en_US,
+            arg.name(), isPolymorphic ? "TYPE()" : "CLASS()",
+            isPolymorphic ? "not extensible" : "extensible");
+      }
     } else {
       messages_.Say(arg.name(),
           "Dummy argument '%s' of a defined input/output procedure must have a"

flang/runtime/CMakeLists.txt

@@ -40,6 +40,7 @@ add_flang_library(FortranRuntime
   connection.cpp
   derived.cpp
   descriptor.cpp
+  descriptor-io.cpp
   dot-product.cpp
   edit-input.cpp
   edit-output.cpp

flang/runtime/derived.cpp

@@ -20,9 +20,9 @@ static const typeInfo::SpecialBinding *FindFinal(
   for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
     const auto &special{
         *specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
-    switch (special.which) {
+    switch (special.which()) {
     case typeInfo::SpecialBinding::Which::Final:
-      if (special.rank == rank) {
+      if (special.rank() == rank) {
         return &special;
       }
       break;
@@ -40,20 +40,20 @@ static const typeInfo::SpecialBinding *FindFinal(
 static void CallFinalSubroutine(
     const Descriptor &descriptor, const typeInfo::DerivedType &derived) {
   if (const auto *special{FindFinal(derived, descriptor.rank())}) {
-    if (special->which == typeInfo::SpecialBinding::Which::ElementalFinal) {
+    if (special->which() == typeInfo::SpecialBinding::Which::ElementalFinal) {
       std::size_t byteStride{descriptor.ElementBytes()};
-      auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
+      auto *p{special->GetProc<void (*)(char *)>()};
       // Finalizable objects must be contiguous.
       std::size_t elements{descriptor.Elements()};
       for (std::size_t j{0}; j < elements; ++j) {
         p(descriptor.OffsetElement<char>(j * byteStride));
       }
-    } else if (special->isArgDescriptorSet & 1) {
+    } else if (special->IsArgDescriptor(0)) {
-      auto p{reinterpret_cast<void (*)(const Descriptor &)>(special->proc)};
+      auto *p{special->GetProc<void (*)(const Descriptor &)>()};
       p(descriptor);
     } else {
       // Finalizable objects must be contiguous.
-      auto p{reinterpret_cast<void (*)(char *)>(special->proc)};
+      auto *p{special->GetProc<void (*)(char *)>()};
       p(descriptor.OffsetElement<char>());
     }
   }

flang/runtime/descriptor-io.cpp

@@ -0,0 +1,106 @@
+//===-- runtime/descriptor-io.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-io.h"
+
+namespace Fortran::runtime::io::descr {
+
+// User-defined derived type formatted I/O (maybe)
+std::optional<bool> DefinedFormattedIo(IoStatementState &io,
+    const Descriptor &descriptor, const typeInfo::SpecialBinding &special) {
+  std::optional<DataEdit> peek{io.GetNextDataEdit(0 /*to peek at it*/)};
+  if (peek &&
+      (peek->descriptor == DataEdit::DefinedDerivedType ||
+          peek->descriptor == DataEdit::ListDirected)) {
+    // User-defined derived type formatting
+    IoErrorHandler &handler{io.GetIoErrorHandler()};
+    DataEdit edit{*io.GetNextDataEdit()}; // consume it this time
+    RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
+    char ioType[2 + edit.maxIoTypeChars];
+    auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
+    if (edit.descriptor == DataEdit::DefinedDerivedType) {
+      ioType[0] = 'D';
+      ioType[1] = 'T';
+      std::memcpy(ioType + 2, edit.ioType, edit.ioTypeChars);
+    } else {
+      std::strcpy(
+          ioType, io.mutableModes().inNamelist ? "NAMELIST" : "LISTDIRECTED");
+      ioTypeLen = std::strlen(ioType);
+    }
+    StaticDescriptor<0, true> statDesc;
+    Descriptor &vListDesc{statDesc.descriptor()};
+    vListDesc.Establish(TypeCategory::Integer, sizeof(int), nullptr, 1);
+    vListDesc.set_base_addr(edit.vList);
+    vListDesc.GetDimension(0).SetBounds(1, edit.vListEntries);
+    vListDesc.GetDimension(0).SetByteStride(
+        static_cast<SubscriptValue>(sizeof(int)));
+    ExternalFileUnit *actualExternal{io.GetExternalFileUnit()};
+    ExternalFileUnit *external{actualExternal};
+    if (!external) {
+      // Create a new unit to service defined I/O for an
+      // internal I/O parent.
+      external = &ExternalFileUnit::NewUnit(handler, true);
+    }
+    ChildIo &child{external->PushChildIo(io)};
+    int unit{external->unitNumber()};
+    int ioStat{IostatOk};
+    char ioMsg[100];
+    if (special.IsArgDescriptor(0)) {
+      auto *p{special.GetProc<void (*)(const Descriptor &, int &, char *,
+          const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
+      p(descriptor, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
+          sizeof ioMsg);
+    } else {
+      auto *p{special.GetProc<void (*)(const void *, int &, char *,
+          const Descriptor &, int &, char *, std::size_t, std::size_t)>()};
+      p(descriptor.raw().base_addr, unit, ioType, vListDesc, ioStat, ioMsg,
+          ioTypeLen, sizeof ioMsg);
+    }
+    handler.Forward(ioStat, ioMsg, sizeof ioMsg);
+    external->PopChildIo(child);
+    if (!actualExternal) {
+      // Close unit created for internal I/O above.
+      auto *closing{external->LookUpForClose(external->unitNumber())};
+      RUNTIME_CHECK(handler, external == closing);
+      external->DestroyClosed();
+    }
+    return handler.GetIoStat() == IostatOk;
+  } else {
+    // There's a user-defined I/O subroutine, but there's a FORMAT present and
+    // it does not have a DT data edit descriptor, so apply default formatting
+    // to the components of the derived type as usual.
+    return std::nullopt;
+  }
+}
+
+// User-defined derived type unformatted I/O
+bool DefinedUnformattedIo(IoStatementState &io, const Descriptor &descriptor,
+    const typeInfo::SpecialBinding &special) {
+  // Unformatted I/O must have an external unit (or child thereof).
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  ExternalFileUnit *external{io.GetExternalFileUnit()};
+  RUNTIME_CHECK(handler, external != nullptr);
+  ChildIo &child{external->PushChildIo(io)};
+  int unit{external->unitNumber()};
+  int ioStat{IostatOk};
+  char ioMsg[100];
+  if (special.IsArgDescriptor(0)) {
+    auto *p{special.GetProc<void (*)(
+        const Descriptor &, int &, int &, char *, std::size_t)>()};
+    p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg);
+  } else {
+    auto *p{special.GetProc<void (*)(
+        const void *, int &, int &, char *, std::size_t)>()};
+    p(descriptor.raw().base_addr, unit, ioStat, ioMsg, sizeof ioMsg);
+  }
+  handler.Forward(ioStat, ioMsg, sizeof ioMsg);
+  external->PopChildIo(child);
+  return handler.GetIoStat() == IostatOk;
+}
+
+} // namespace Fortran::runtime::io::descr

flang/runtime/descriptor-io.h

@@ -10,6 +10,9 @@
 #define FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
 
 // Implementation of I/O data list item transfers based on descriptors.
+// (All I/O items come through here so that the code is exercised for test;
+// some scalar I/O data transfer APIs could be changed to bypass their use
+// of descriptors in the future for better efficiency.)
 
 #include "cpp-type.h"
 #include "descriptor.h"
@@ -18,6 +21,7 @@
 #include "io-stmt.h"
 #include "terminator.h"
 #include "type-info.h"
+#include "unit.h"
 #include "flang/Common/uint128.h"
 
 namespace Fortran::runtime::io::descr {
@@ -243,42 +247,110 @@ static bool DefaultFormattedComponentIO(IoStatementState &io,
   }
 }
 
+std::optional<bool> DefinedFormattedIo(
+    IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
+
 template <Direction DIR>
 static bool FormattedDerivedTypeIO(
     IoStatementState &io, const Descriptor &descriptor) {
-  Terminator &terminator{io.GetIoErrorHandler()};
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  // Derived type information must be present for formatted I/O.
   const DescriptorAddendum *addendum{descriptor.Addendum()};
-  RUNTIME_CHECK(terminator, addendum != nullptr);
+  RUNTIME_CHECK(handler, addendum != nullptr);
   const typeInfo::DerivedType *type{addendum->derivedType()};
-  RUNTIME_CHECK(terminator, type != nullptr);
+  RUNTIME_CHECK(handler, type != nullptr);
-  if (false) {
+  if (const typeInfo::SpecialBinding *
-    // TODO: user-defined derived type formatted I/O
+      special{type->FindSpecialBinding(DIR == Direction::Input
-  } else {
+              ? typeInfo::SpecialBinding::Which::ReadFormatted
-    // Default derived type formatting
+              : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
-    const Descriptor &compArray{type->component()};
+    if (std::optional<bool> wasDefined{
-    RUNTIME_CHECK(terminator, compArray.rank() == 1);
+            DefinedFormattedIo(io, descriptor, *special)}) {
-    std::size_t numComponents{compArray.Elements()};
+      return *wasDefined; // user-defined I/O was applied
-    std::size_t numElements{descriptor.Elements()};
+    }
-    SubscriptValue subscripts[maxRank];
+  }
-    descriptor.GetLowerBounds(subscripts);
+  // Default componentwise derived type formatting
-    for (std::size_t j{0}; j < numElements;
+  const Descriptor &compArray{type->component()};
-         ++j, descriptor.IncrementSubscripts(subscripts)) {
+  RUNTIME_CHECK(handler, compArray.rank() == 1);
-      SubscriptValue at[maxRank];
+  std::size_t numComponents{compArray.Elements()};
-      compArray.GetLowerBounds(at);
+  std::size_t numElements{descriptor.Elements()};
-      for (std::size_t k{0}; k < numComponents;
+  SubscriptValue subscripts[maxRank];
-           ++k, compArray.IncrementSubscripts(at)) {
+  descriptor.GetLowerBounds(subscripts);
-        const typeInfo::Component &component{
+  for (std::size_t j{0}; j < numElements;
-            *compArray.Element<typeInfo::Component>(at)};
+       ++j, descriptor.IncrementSubscripts(subscripts)) {
-        if (!DefaultFormattedComponentIO<DIR>(
+    SubscriptValue at[maxRank];
-                io, component, descriptor, subscripts, terminator)) {
+    compArray.GetLowerBounds(at);
-          return false;
+    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, handler)) {
+        return false;
       }
     }
   }
   return true;
 }
 
+bool DefinedUnformattedIo(
+    IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
+
+// Unformatted I/O
+template <Direction DIR>
+static bool UnformattedDescriptorIO(
+    IoStatementState &io, const Descriptor &descriptor) {
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  const DescriptorAddendum *addendum{descriptor.Addendum()};
+  const typeInfo::DerivedType *type{
+      addendum ? addendum->derivedType() : nullptr};
+  if (const typeInfo::SpecialBinding *
+      special{type
+              ? type->FindSpecialBinding(DIR == Direction::Input
+                        ? typeInfo::SpecialBinding::Which::ReadUnformatted
+                        : typeInfo::SpecialBinding::Which::WriteUnformatted)
+              : nullptr}) {
+    // User-defined derived type unformatted I/O
+    return DefinedUnformattedIo(io, descriptor, *special);
+  } else {
+    // Regular derived type unformatted I/O, not user-defined
+    auto *externalUnf{io.get_if<ExternalUnformattedIoStatementState<DIR>>()};
+    auto *childUnf{io.get_if<ChildUnformattedIoStatementState<DIR>>()};
+    RUNTIME_CHECK(handler, externalUnf != nullptr || childUnf != nullptr);
+    std::size_t elementBytes{descriptor.ElementBytes()};
+    std::size_t numElements{descriptor.Elements()};
+    SubscriptValue subscripts[maxRank];
+    descriptor.GetLowerBounds(subscripts);
+    using CharType =
+        std::conditional_t<DIR == Direction::Output, const char, char>;
+    auto Transfer{[=](CharType &x, std::size_t totalBytes,
+                      std::size_t elementBytes) -> bool {
+      if constexpr (DIR == Direction::Output) {
+        return externalUnf ? externalUnf->Emit(&x, totalBytes, elementBytes)
+                           : childUnf->Emit(&x, totalBytes, elementBytes);
+      } else {
+        return externalUnf ? externalUnf->Receive(&x, totalBytes, elementBytes)
+                           : childUnf->Receive(&x, totalBytes, elementBytes);
+      }
+    }};
+    if (descriptor.IsContiguous()) { // contiguous unformatted I/O
+      char &x{ExtractElement<char>(io, descriptor, subscripts)};
+      return Transfer(x, numElements * elementBytes, elementBytes);
+    } else { // non-contiguous unformatted I/O
+      for (std::size_t j{0}; j < numElements; ++j) {
+        char &x{ExtractElement<char>(io, descriptor, subscripts)};
+        if (!Transfer(x, elementBytes, elementBytes)) {
+          return false;
+        }
+        if (!descriptor.IncrementSubscripts(subscripts) &&
+            j + 1 < numElements) {
+          handler.Crash("DescriptorIO: subscripts out of bounds");
+        }
+      }
+      return true;
+    }
+  }
+}
+
 template <Direction DIR>
 static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
   if (!io.get_if<IoDirectionState<DIR>>()) {
@@ -291,44 +363,14 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
       return false;
     }
   }
-  if (auto *unf{io.get_if<UnformattedIoStatementState<DIR>>()}) {
+  if (!io.get_if<FormattedIoStatementState>()) {
-    std::size_t elementBytes{descriptor.ElementBytes()};
+    return UnformattedDescriptorIO<DIR>(io, descriptor);
-    SubscriptValue subscripts[maxRank];
+  }
-    descriptor.GetLowerBounds(subscripts);
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
-    std::size_t numElements{descriptor.Elements()};
+  if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
-    if (false) {
+    TypeCategory cat{catAndKind->first};
-      // 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
-      for (std::size_t j{0}; j < numElements; ++j) {
-        char &x{ExtractElement<char>(io, descriptor, subscripts)};
-        if constexpr (DIR == Direction::Output) {
-          if (!unf->Emit(&x, elementBytes, elementBytes)) {
-            return false;
-          }
-        } else {
-          if (!unf->Receive(&x, elementBytes, elementBytes)) {
-            return false;
-          }
-        }
-        if (!descriptor.IncrementSubscripts(subscripts) &&
-            j + 1 < numElements) {
-          io.GetIoErrorHandler().Crash(
-              "DescriptorIO: subscripts out of bounds");
-        }
-      }
-      return true;
-    }
-  } else if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
     int kind{catAndKind->second};
-    switch (catAndKind->first) {
+    switch (cat) {
     case TypeCategory::Integer:
       switch (kind) {
       case 1:
@@ -347,7 +389,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
         return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 16>, DIR>(
             io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented INTEGER kind (%d) in descriptor",
             kind);
         return false;
@@ -368,7 +410,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
       case 16:
         return FormattedRealIO<16, DIR>(io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented REAL kind (%d) in descriptor", kind);
         return false;
       }
@@ -388,7 +430,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
       case 16:
         return FormattedComplexIO<16, DIR>(io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented COMPLEX kind (%d) in descriptor",
             kind);
         return false;
@@ -399,7 +441,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
         return FormattedCharacterIO<char, DIR>(io, descriptor);
       // TODO cases 2, 4
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented CHARACTER kind (%d) in descriptor",
             kind);
         return false;
@@ -419,7 +461,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
         return FormattedLogicalIO<CppTypeFor<TypeCategory::Integer, 8>, DIR>(
             io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented LOGICAL kind (%d) in descriptor",
             kind);
         return false;
@@ -428,7 +470,7 @@ static bool DescriptorIO(IoStatementState &io, const Descriptor &descriptor) {
       return FormattedDerivedTypeIO<DIR>(io, descriptor);
     }
   }
-  io.GetIoErrorHandler().Crash("DescriptorIO: Bad type code (%d) in descriptor",
+  handler.Crash("DescriptorIO: Bad type code (%d) in descriptor",
       static_cast<int>(descriptor.type().raw()));
   return false;
 }

flang/runtime/format-implementation.h

@@ -338,10 +338,12 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
           ++offset_;
         }
       }
-      if (ch == 'E' ||
+      if ((!next &&
-          (!next &&
+              (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'E' || ch == 'D' ||
-              (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'O' || ch == 'Z' ||
+                  ch == 'O' || ch == 'Z' || ch == 'F' || ch == 'G' ||
-                  ch == 'F' || ch == 'D' || ch == 'G' || ch == 'L'))) {
+                  ch == 'L')) ||
+          (ch == 'E' && (next == 'N' || next == 'S' || next == 'X')) ||
+          (ch == 'D' && next == 'T')) {
         // Data edit descriptor found
         offset_ = start;
         return repeat && *repeat > 0 ? *repeat : 1;
@@ -363,34 +365,86 @@ int FormatControl<CONTEXT>::CueUpNextDataEdit(Context &context, bool stop) {
   }
 }
 
+// Returns the next data edit descriptor
 template <typename CONTEXT>
 DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
     Context &context, int maxRepeat) {
-
-  // TODO: DT editing
-
-  // Return the next data edit descriptor
   int repeat{CueUpNextDataEdit(context)};
   auto start{offset_};
   DataEdit edit;
   edit.descriptor = static_cast<char>(Capitalize(GetNextChar(context)));
   if (edit.descriptor == 'E') {
-    edit.variation = static_cast<char>(Capitalize(PeekNext()));
+    if (auto next{static_cast<char>(Capitalize(PeekNext()))};
-    if (edit.variation >= 'A' && edit.variation <= 'Z') {
+        next == 'N' || next == 'S' || next == 'X') {
+      edit.variation = next;
       ++offset_;
     }
+  } else if (edit.descriptor == 'D' && Capitalize(PeekNext()) == 'T') {
+    // DT'iotype'(v_list) user-defined derived type I/O
+    edit.descriptor = DataEdit::DefinedDerivedType;
+    ++offset_;
+    if (auto quote{static_cast<char>(PeekNext())};
+        quote == '\'' || quote == '"') {
+      // Capture the quoted 'iotype'
+      bool ok{false}, tooLong{false};
+      for (++offset_; offset_ < formatLength_;) {
+        auto ch{static_cast<char>(format_[offset_++])};
+        if (ch == quote &&
+            (offset_ == formatLength_ ||
+                static_cast<char>(format_[offset_]) != quote)) {
+          ok = true;
+          break; // that was terminating quote
+        } else if (edit.ioTypeChars >= edit.maxIoTypeChars) {
+          tooLong = true;
+        } else {
+          edit.ioType[edit.ioTypeChars++] = ch;
+          if (ch == quote) {
+            ++offset_;
+          }
+        }
+      }
+      if (!ok) {
+        context.SignalError(
+            IostatErrorInFormat, "Unclosed DT'iotype' in FORMAT");
+      } else if (tooLong) {
+        context.SignalError(
+            IostatErrorInFormat, "Excessive DT'iotype' in FORMAT");
+      }
+    }
+    if (PeekNext() == '(') {
+      // Capture the v_list arguments
+      bool ok{false}, tooLong{false};
+      for (++offset_; offset_ < formatLength_;) {
+        int n{GetIntField(context)};
+        if (edit.vListEntries >= edit.maxVListEntries) {
+          tooLong = true;
+        } else {
+          edit.vList[edit.vListEntries++] = n;
+        }
+        auto ch{static_cast<char>(GetNextChar(context))};
+        if (ch != ',') {
+          ok = ch == ')';
+          break;
+        }
+      }
+      if (!ok) {
+        context.SignalError(
+            IostatErrorInFormat, "Unclosed DT(v_list) in FORMAT");
+      } else if (tooLong) {
+        context.SignalError(
+            IostatErrorInFormat, "Excessive DT(v_list) in FORMAT");
+      }
+    }
   }
-
   if (edit.descriptor == 'A') { // width is optional for A[w]
     auto ch{PeekNext()};
     if (ch >= '0' && ch <= '9') {
       edit.width = GetIntField(context);
     }
-  } else {
+  } else if (edit.descriptor != DataEdit::DefinedDerivedType) {
     edit.width = GetIntField(context);
   }
-  edit.modes = context.mutableModes();
+  if (edit.descriptor != DataEdit::DefinedDerivedType && PeekNext() == '.') {
-  if (PeekNext() == '.') {
     ++offset_;
     edit.digits = GetIntField(context);
     CharType ch{PeekNext()};
@@ -399,14 +453,15 @@ DataEdit FormatControl<CONTEXT>::GetNextDataEdit(
       edit.expoDigits = GetIntField(context);
     }
   }
+  edit.modes = context.mutableModes();
 
   // Handle repeated nonparenthesized edit descriptors
-  if (repeat > 1) {
+  if (repeat > maxRepeat) {
     stack_[height_].start = start; // after repeat count
     stack_[height_].remaining = repeat; // full count
     ++height_;
   }
-  edit.repeat = 1;
+  edit.repeat = std::min(1, maxRepeat); // 0 if maxRepeat==0
   if (height_ > 1) { // Subtle: stack_[0].start doesn't necessarily point to '('
     int start{stack_[height_ - 1].start};
     if (format_[start] != '(') {

flang/runtime/format.cpp

@@ -9,50 +9,6 @@
 #include "format-implementation.h"
 
 namespace Fortran::runtime::io {
-
-DataEdit DefaultFormatControlCallbacks::GetNextDataEdit(int) {
-  Crash("DefaultFormatControlCallbacks::GetNextDataEdit() called for "
-        "non-formatted I/O statement");
-  return {};
-}
-bool DefaultFormatControlCallbacks::Emit(
-    const char *, std::size_t, std::size_t) {
-  Crash("DefaultFormatControlCallbacks::Emit(char) called for non-output I/O "
-        "statement");
-  return {};
-}
-bool DefaultFormatControlCallbacks::Emit(const char16_t *, std::size_t) {
-  Crash("DefaultFormatControlCallbacks::Emit(char16_t) called for non-output "
-        "I/O statement");
-  return {};
-}
-bool DefaultFormatControlCallbacks::Emit(const char32_t *, std::size_t) {
-  Crash("DefaultFormatControlCallbacks::Emit(char32_t) called for non-output "
-        "I/O statement");
-  return {};
-}
-std::optional<char32_t> DefaultFormatControlCallbacks::GetCurrentChar() {
-  Crash("DefaultFormatControlCallbacks::GetCurrentChar() called for non-input "
-        "I/O "
-        "statement");
-  return {};
-}
-bool DefaultFormatControlCallbacks::AdvanceRecord(int) {
-  Crash("DefaultFormatControlCallbacks::AdvanceRecord() called unexpectedly");
-  return {};
-}
-void DefaultFormatControlCallbacks::BackspaceRecord() {
-  Crash("DefaultFormatControlCallbacks::BackspaceRecord() called unexpectedly");
-}
-void DefaultFormatControlCallbacks::HandleAbsolutePosition(std::int64_t) {
-  Crash("DefaultFormatControlCallbacks::HandleAbsolutePosition() called for "
-        "non-formatted I/O statement");
-}
-void DefaultFormatControlCallbacks::HandleRelativePosition(std::int64_t) {
-  Crash("DefaultFormatControlCallbacks::HandleRelativePosition() called for "
-        "non-formatted I/O statement");
-}
-
 template class FormatControl<
     InternalFormattedIoStatementState<Direction::Output>>;
 template class FormatControl<
@@ -61,4 +17,6 @@ template class FormatControl<
     ExternalFormattedIoStatementState<Direction::Output>>;
 template class FormatControl<
     ExternalFormattedIoStatementState<Direction::Input>>;
+template class FormatControl<ChildFormattedIoStatementState<Direction::Output>>;
+template class FormatControl<ChildFormattedIoStatementState<Direction::Input>>;
 } // namespace Fortran::runtime::io

flang/runtime/format.h

@@ -51,32 +51,28 @@ struct DataEdit {
         descriptor == ListDirectedImaginaryPart;
   }
 
+  static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
+
   char variation{'\0'}; // N, S, or X for EN, ES, EX
   std::optional<int> width; // the 'w' field; optional for A
   std::optional<int> digits; // the 'm' or 'd' field
   std::optional<int> expoDigits; // 'Ee' field
   MutableModes modes;
   int repeat{1};
-};
 
-// FormatControl<A> requires that A have these member functions;
+  // "iotype" &/or "v_list" values for a DT'iotype'(v_list)
-// these default implementations just crash if called.
+  // user-defined derived type data edit descriptor
-struct DefaultFormatControlCallbacks : public IoErrorHandler {
+  static constexpr std::size_t maxIoTypeChars{32};
-  using IoErrorHandler::IoErrorHandler;
+  static constexpr std::size_t maxVListEntries{4};
-  DataEdit GetNextDataEdit(int = 1);
+  std::uint8_t ioTypeChars{0};
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
+  std::uint8_t vListEntries{0};
-  bool Emit(const char16_t *, std::size_t);
+  char ioType[maxIoTypeChars];
-  bool Emit(const char32_t *, std::size_t);
+  int vList[maxVListEntries];
-  std::optional<char32_t> GetCurrentChar();
-  bool AdvanceRecord(int = 1);
-  void BackspaceRecord();
-  void HandleAbsolutePosition(std::int64_t);
-  void HandleRelativePosition(std::int64_t);
 };
 
 // Generates a sequence of DataEdits from a FORMAT statement or
 // default-CHARACTER string.  Driven by I/O item list processing.
-// Errors are fatal.  See clause 13.4 in Fortran 2018 for background.
+// Errors are fatal.  See subclause 13.4 in Fortran 2018 for background.
 template <typename CONTEXT> class FormatControl {
 public:
   using Context = CONTEXT;
@@ -98,7 +94,8 @@ public:
   }
 
   // Extracts the next data edit descriptor, handling control edit descriptors
-  // along the way.
+  // along the way.  If maxRepeat==0, this is a peek at the next data edit
+  // descriptor.
   DataEdit GetNextDataEdit(Context &, int maxRepeat = 1);
 
   // Emit any remaining character literals after the last data item (on output)

flang/runtime/io-api.cpp

@@ -156,22 +156,29 @@ Cookie BeginExternalListIO(const char *what, int unitNumber,
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
-  if (unit.access == Access::Direct) {
+  if (ChildIo * child{unit.GetChildIo()}) {
-    terminator.Crash("%s attempted on direct access file", what);
+    return child->CheckFormattingAndDirection(terminator, what, false, DIR)
-    return nullptr;
+        ? &child->BeginIoStatement<ChildListIoStatementState<DIR>>(
+              *child, sourceFile, sourceLine)
+        : nullptr;
+  } else {
+    if (unit.access == Access::Direct) {
+      terminator.Crash("%s attempted on direct access file", what);
+      return nullptr;
+    }
+    if (!unit.isUnformatted.has_value()) {
+      unit.isUnformatted = false;
+    }
+    if (*unit.isUnformatted) {
+      terminator.Crash("%s attempted on unformatted file", what);
+      return nullptr;
+    }
+    IoErrorHandler handler{terminator};
+    unit.SetDirection(DIR, handler);
+    IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
+        std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
+    return &io;
   }
-  if (!unit.isUnformatted.has_value()) {
-    unit.isUnformatted = false;
-  }
-  if (*unit.isUnformatted) {
-    terminator.Crash("%s attempted on unformatted file", what);
-    return nullptr;
-  }
-  IoErrorHandler handler{terminator};
-  unit.SetDirection(DIR, handler);
-  IoStatementState &io{unit.BeginIoStatement<STATE<DIR>>(
-      std::forward<A>(xs)..., unit, sourceFile, sourceLine)};
-  return &io;
 }
 
 Cookie IONAME(BeginExternalListOutput)(
@@ -195,19 +202,29 @@ Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
-  if (!unit.isUnformatted.has_value()) {
+  if (ChildIo * child{unit.GetChildIo()}) {
-    unit.isUnformatted = false;
+    return child->CheckFormattingAndDirection(terminator,
+               DIR == Direction::Output ? "formatted output"
+                                        : "formatted input",
+               false, DIR)
+        ? &child->BeginIoStatement<ChildFormattedIoStatementState<DIR>>(
+              *child, sourceFile, sourceLine)
+        : nullptr;
+  } else {
+    if (!unit.isUnformatted.has_value()) {
+      unit.isUnformatted = false;
+    }
+    if (*unit.isUnformatted) {
+      terminator.Crash("Formatted I/O attempted on unformatted file");
+      return nullptr;
+    }
+    IoErrorHandler handler{terminator};
+    unit.SetDirection(DIR, handler);
+    IoStatementState &io{
+        unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
+            unit, format, formatLength, sourceFile, sourceLine)};
+    return &io;
   }
-  if (*unit.isUnformatted) {
-    terminator.Crash("Formatted I/O attempted on unformatted file");
-    return nullptr;
-  }
-  IoErrorHandler handler{terminator};
-  unit.SetDirection(DIR, handler);
-  IoStatementState &io{
-      unit.BeginIoStatement<ExternalFormattedIoStatementState<DIR>>(
-          unit, format, formatLength, sourceFile, sourceLine)};
-  return &io;
 }
 
 Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
@@ -230,25 +247,36 @@ Cookie BeginUnformattedIO(
   Terminator terminator{sourceFile, sourceLine};
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, true /*unformatted*/, terminator)};
-  if (!unit.isUnformatted.has_value()) {
+  if (ChildIo * child{unit.GetChildIo()}) {
-    unit.isUnformatted = true;
+    return child->CheckFormattingAndDirection(terminator,
-  }
+               DIR == Direction::Output ? "unformatted output"
-  if (!*unit.isUnformatted) {
+                                        : "unformatted input",
-    terminator.Crash("Unformatted I/O attempted on formatted file");
+               true, DIR)
-  }
+        ? &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
-  IoStatementState &io{unit.BeginIoStatement<UnformattedIoStatementState<DIR>>(
+              *child, sourceFile, sourceLine)
-      unit, sourceFile, sourceLine)};
+        : nullptr;
-  IoErrorHandler handler{terminator};
+  } else {
-  unit.SetDirection(DIR, handler);
+    if (!unit.isUnformatted.has_value()) {
-  if constexpr (DIR == Direction::Output) {
+      unit.isUnformatted = true;
-    if (unit.access == Access::Sequential && !unit.isFixedRecordLength) {
-      // Create space for (sub)record header to be completed by
-      // UnformattedIoStatementState<Direction::Output>::EndIoStatement()
-      unit.recordLength.reset(); // in case of prior BACKSPACE
-      io.Emit("\0\0\0\0", 4); // placeholder for record length header
     }
+    if (!*unit.isUnformatted) {
+      terminator.Crash("Unformatted I/O attempted on formatted file");
+    }
+    IoStatementState &io{
+        unit.BeginIoStatement<ExternalUnformattedIoStatementState<DIR>>(
+            unit, sourceFile, sourceLine)};
+    IoErrorHandler handler{terminator};
+    unit.SetDirection(DIR, handler);
+    if constexpr (DIR == Direction::Output) {
+      if (unit.access == Access::Sequential && !unit.isFixedRecordLength) {
+        // Create space for (sub)record header to be completed by
+        // ExternalUnformattedIoStatementState<Direction::Output>::EndIoStatement()
+        unit.recordLength.reset(); // in case of prior BACKSPACE
+        io.Emit("\0\0\0\0", 4); // placeholder for record length header
+      }
+    }
+    return &io;
   }
-  return &io;
 }
 
 Cookie IONAME(BeginUnformattedOutput)(
@@ -276,9 +304,7 @@ Cookie IONAME(BeginOpenUnit)( // OPEN(without NEWUNIT=)
 Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
-  bool ignored{false};
+  ExternalFileUnit &unit{ExternalFileUnit::NewUnit(terminator)};
-  ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreate(
-      ExternalFileUnit::NewUnit(terminator), terminator, ignored)};
   return &unit.BeginIoStatement<OpenStatementState>(
       unit, false /*was an existing file*/, sourceFile, sourceLine);
 }
@@ -895,7 +921,8 @@ bool IONAME(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
 bool IONAME(OutputUnformattedBlock)(Cookie cookie, const char *x,
     std::size_t length, std::size_t elementBytes) {
   IoStatementState &io{*cookie};
-  if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Output>>()}) {
+  if (auto *unf{io.get_if<
+          ExternalUnformattedIoStatementState<Direction::Output>>()}) {
     return unf->Emit(x, length, elementBytes);
   }
   io.GetIoErrorHandler().Crash("OutputUnformattedBlock() called for an I/O "
@@ -910,7 +937,8 @@ bool IONAME(InputUnformattedBlock)(
   if (io.GetIoErrorHandler().InError()) {
     return false;
   }
-  if (auto *unf{io.get_if<UnformattedIoStatementState<Direction::Input>>()}) {
+  if (auto *unf{
+          io.get_if<ExternalUnformattedIoStatementState<Direction::Input>>()}) {
     return unf->Receive(x, length, elementBytes);
   }
   io.GetIoErrorHandler().Crash("InputUnformattedBlock() called for an I/O "

flang/runtime/io-error.cpp

@@ -57,6 +57,14 @@ void IoErrorHandler::SignalError(int iostatOrErrno) {
   SignalError(iostatOrErrno, nullptr);
 }
 
+void IoErrorHandler::Forward(
+    int ioStatOrErrno, const char *msg, std::size_t length) {
+  SignalError(ioStatOrErrno);
+  if (ioStat_ != IostatOk && (flags_ & hasIoMsg)) {
+    ioMsg_ = SaveDefaultCharacter(msg, length, *this);
+  }
+}
+
 void IoErrorHandler::SignalErrno() { SignalError(errno); }
 
 void IoErrorHandler::SignalEnd() { SignalError(IostatEnd); }

flang/runtime/io-error.h

@@ -32,6 +32,9 @@ public:
   void HasEndLabel() { flags_ |= hasEnd; }
   void HasEorLabel() { flags_ |= hasEor; }
   void HasIoMsg() { flags_ |= hasIoMsg; }
+  void HandleAnything() {
+    flags_ = hasIoStat | hasErr | hasEnd | hasEor | hasIoMsg;
+  }
 
   bool InError() const { return ioStat_ != IostatOk; }
 
@@ -41,6 +44,8 @@ public:
     SignalError(IostatGenericError, msg, std::forward<X>(xs)...);
   }
 
+  void Forward(int iostatOrErrno, const char *, std::size_t);
+
   void SignalErrno(); // SignalError(errno)
   void SignalEnd(); // input only; EOF on internal write is an error
   void SignalEor(); // non-advancing input only; EOR on write is an error

flang/runtime/io-stmt.cpp

@@ -21,32 +21,64 @@ namespace Fortran::runtime::io {
 
 int IoStatementBase::EndIoStatement() { return GetIoStat(); }
 
+bool IoStatementBase::Emit(const char *, std::size_t, std::size_t) {
+  return false;
+}
+
+bool IoStatementBase::Emit(const char *, std::size_t) {
+  return false;
+}
+
+bool IoStatementBase::Emit(const char16_t *, std::size_t) {
+  return false;
+}
+
+bool IoStatementBase::Emit(const char32_t *, std::size_t) {
+  return false;
+}
+
+std::optional<char32_t> IoStatementBase::GetCurrentChar() {
+  return std::nullopt;
+}
+
+bool IoStatementBase::AdvanceRecord(int) { return false; }
+
+void IoStatementBase::BackspaceRecord() {}
+
+bool IoStatementBase::Receive(char *, std::size_t, std::size_t) {
+  return false;
+}
+
 std::optional<DataEdit> IoStatementBase::GetNextDataEdit(
     IoStatementState &, int) {
   return std::nullopt;
 }
 
+ExternalFileUnit *IoStatementBase::GetExternalFileUnit() const {
+  return nullptr;
+}
+
+bool IoStatementBase::BeginReadingRecord() { return true; }
+
+void IoStatementBase::FinishReadingRecord() {}
+
+void IoStatementBase::HandleAbsolutePosition(std::int64_t) {}
+
+void IoStatementBase::HandleRelativePosition(std::int64_t) {}
+
 bool IoStatementBase::Inquire(InquiryKeywordHash, char *, std::size_t) {
-  Crash(
-      "IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
   return false;
 }
 
 bool IoStatementBase::Inquire(InquiryKeywordHash, bool &) {
-  Crash(
-      "IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
   return false;
 }
 
 bool IoStatementBase::Inquire(InquiryKeywordHash, std::int64_t, bool &) {
-  Crash(
-      "IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
   return false;
 }
 
 bool IoStatementBase::Inquire(InquiryKeywordHash, std::int64_t &) {
-  Crash(
-      "IoStatementBase::Inquire() called for I/O statement other than INQUIRE");
   return false;
 }
 
@@ -69,12 +101,12 @@ InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
 
 template <Direction DIR, typename CHAR>
 bool InternalIoStatementState<DIR, CHAR>::Emit(
-    const CharType *data, std::size_t chars, std::size_t /*elementBytes*/) {
+    const CharType *data, std::size_t chars) {
   if constexpr (DIR == Direction::Input) {
     Crash("InternalIoStatementState<Direction::Input>::Emit() called");
     return false;
   }
-  return unit_.Emit(data, chars, *this);
+  return unit_.Emit(data, chars * sizeof(CharType), *this);
 }
 
 template <Direction DIR, typename CHAR>
@@ -252,6 +284,14 @@ bool ExternalIoStatementState<DIR>::Emit(
   return unit().Emit(data, bytes, elementBytes, *this);
 }
 
+template <Direction DIR>
+bool ExternalIoStatementState<DIR>::Emit(const char *data, std::size_t bytes) {
+  if constexpr (DIR == Direction::Input) {
+    Crash("ExternalIoStatementState::Emit(char) called for input statement");
+  }
+  return unit().Emit(data, bytes, 0, *this);
+}
+
 template <Direction DIR>
 bool ExternalIoStatementState<DIR>::Emit(
     const char16_t *data, std::size_t chars) {
@@ -261,7 +301,7 @@ bool ExternalIoStatementState<DIR>::Emit(
   }
   // TODO: UTF-8 encoding
   return unit().Emit(reinterpret_cast<const char *>(data), chars * sizeof *data,
-      static_cast<int>(sizeof *data), *this);
+      sizeof *data, *this);
 }
 
 template <Direction DIR>
@@ -273,7 +313,7 @@ bool ExternalIoStatementState<DIR>::Emit(
   }
   // TODO: UTF-8 encoding
   return unit().Emit(reinterpret_cast<const char *>(data), chars * sizeof *data,
-      static_cast<int>(sizeof *data), *this);
+      sizeof *data, *this);
 }
 
 template <Direction DIR>
@@ -354,6 +394,24 @@ bool IoStatementState::Emit(
       [=](auto &x) { return x.get().Emit(data, n, elementBytes); }, u_);
 }
 
+bool IoStatementState::Emit(const char *data, std::size_t n) {
+  return std::visit([=](auto &x) { return x.get().Emit(data, n); }, u_);
+}
+
+bool IoStatementState::Emit(const char16_t *data, std::size_t chars) {
+  return std::visit([=](auto &x) { return x.get().Emit(data, chars); }, u_);
+}
+
+bool IoStatementState::Emit(const char32_t *data, std::size_t chars) {
+  return std::visit([=](auto &x) { return x.get().Emit(data, chars); }, u_);
+}
+
+bool IoStatementState::Receive(
+    char *data, std::size_t n, std::size_t elementBytes) {
+  return std::visit(
+      [=](auto &x) { return x.get().Receive(data, n, elementBytes); }, u_);
+}
+
 std::optional<char32_t> IoStatementState::GetCurrentChar() {
   return std::visit([&](auto &x) { return x.get().GetCurrentChar(); }, u_);
 }
@@ -370,6 +428,10 @@ void IoStatementState::HandleRelativePosition(std::int64_t n) {
   std::visit([=](auto &x) { x.get().HandleRelativePosition(n); }, u_);
 }
 
+void IoStatementState::HandleAbsolutePosition(std::int64_t n) {
+  std::visit([=](auto &x) { x.get().HandleAbsolutePosition(n); }, u_);
+}
+
 int IoStatementState::EndIoStatement() {
   return std::visit([](auto &x) { return x.get().EndIoStatement(); }, u_);
 }
@@ -682,23 +744,100 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
 }
 
 template <Direction DIR>
-bool UnformattedIoStatementState<DIR>::Receive(
+bool ExternalUnformattedIoStatementState<DIR>::Receive(
     char *data, std::size_t bytes, std::size_t elementBytes) {
   if constexpr (DIR == Direction::Output) {
-    this->Crash(
+    this->Crash("ExternalUnformattedIoStatementState::Receive() called for "
-        "UnformattedIoStatementState::Receive() called for output statement");
+                "output statement");
   }
   return this->unit().Receive(data, bytes, elementBytes, *this);
 }
 
 template <Direction DIR>
-bool UnformattedIoStatementState<DIR>::Emit(
+ChildIoStatementState<DIR>::ChildIoStatementState(
+    ChildIo &child, const char *sourceFile, int sourceLine)
+    : IoStatementBase{sourceFile, sourceLine}, child_{child} {}
+
+template <Direction DIR>
+MutableModes &ChildIoStatementState<DIR>::mutableModes() {
+  return child_.parent().mutableModes();
+}
+
+template <Direction DIR>
+ConnectionState &ChildIoStatementState<DIR>::GetConnectionState() {
+  return child_.parent().GetConnectionState();
+}
+
+template <Direction DIR>
+ExternalFileUnit *ChildIoStatementState<DIR>::GetExternalFileUnit() const {
+  return child_.parent().GetExternalFileUnit();
+}
+
+template <Direction DIR> int ChildIoStatementState<DIR>::EndIoStatement() {
+  auto result{IoStatementBase::EndIoStatement()};
+  child_.EndIoStatement(); // annihilates *this in child_.u_
+  return result;
+}
+
+template <Direction DIR>
+bool ChildIoStatementState<DIR>::Emit(
     const char *data, std::size_t bytes, std::size_t elementBytes) {
-  if constexpr (DIR == Direction::Input) {
+  return child_.parent().Emit(data, bytes, elementBytes);
-    this->Crash(
+}
-        "UnformattedIoStatementState::Emit() called for input statement");
+
-  }
+template <Direction DIR>
-  return ExternalIoStatementState<DIR>::Emit(data, bytes, elementBytes);
+bool ChildIoStatementState<DIR>::Emit(const char *data, std::size_t bytes) {
+  return child_.parent().Emit(data, bytes);
+}
+
+template <Direction DIR>
+bool ChildIoStatementState<DIR>::Emit(const char16_t *data, std::size_t chars) {
+  return child_.parent().Emit(data, chars);
+}
+
+template <Direction DIR>
+bool ChildIoStatementState<DIR>::Emit(const char32_t *data, std::size_t chars) {
+  return child_.parent().Emit(data, chars);
+}
+
+template <Direction DIR>
+std::optional<char32_t> ChildIoStatementState<DIR>::GetCurrentChar() {
+  return child_.parent().GetCurrentChar();
+}
+
+template <Direction DIR>
+void ChildIoStatementState<DIR>::HandleAbsolutePosition(std::int64_t n) {
+  return child_.parent().HandleAbsolutePosition(n);
+}
+
+template <Direction DIR>
+void ChildIoStatementState<DIR>::HandleRelativePosition(std::int64_t n) {
+  return child_.parent().HandleRelativePosition(n);
+}
+
+template <Direction DIR, typename CHAR>
+ChildFormattedIoStatementState<DIR, CHAR>::ChildFormattedIoStatementState(
+    ChildIo &child, const CHAR *format, std::size_t formatLength,
+    const char *sourceFile, int sourceLine)
+    : ChildIoStatementState<DIR>{child, sourceFile, sourceLine},
+      mutableModes_{child.parent().mutableModes()}, format_{*this, format,
+                                                        formatLength} {}
+
+template <Direction DIR, typename CHAR>
+int ChildFormattedIoStatementState<DIR, CHAR>::EndIoStatement() {
+  format_.Finish(*this);
+  return ChildIoStatementState<DIR>::EndIoStatement();
+}
+
+template <Direction DIR, typename CHAR>
+bool ChildFormattedIoStatementState<DIR, CHAR>::AdvanceRecord(int) {
+  return false; // no can do in a child I/O
+}
+
+template <Direction DIR>
+bool ChildUnformattedIoStatementState<DIR>::Receive(
+    char *data, std::size_t bytes, std::size_t elementBytes) {
+  return this->child().parent().Receive(data, bytes, elementBytes);
 }
 
 template class InternalIoStatementState<Direction::Output>;
@@ -713,8 +852,16 @@ template class ExternalFormattedIoStatementState<Direction::Output>;
 template class ExternalFormattedIoStatementState<Direction::Input>;
 template class ExternalListIoStatementState<Direction::Output>;
 template class ExternalListIoStatementState<Direction::Input>;
-template class UnformattedIoStatementState<Direction::Output>;
+template class ExternalUnformattedIoStatementState<Direction::Output>;
-template class UnformattedIoStatementState<Direction::Input>;
+template class ExternalUnformattedIoStatementState<Direction::Input>;
+template class ChildIoStatementState<Direction::Output>;
+template class ChildIoStatementState<Direction::Input>;
+template class ChildFormattedIoStatementState<Direction::Output>;
+template class ChildFormattedIoStatementState<Direction::Input>;
+template class ChildListIoStatementState<Direction::Output>;
+template class ChildListIoStatementState<Direction::Input>;
+template class ChildUnformattedIoStatementState<Direction::Output>;
+template class ChildUnformattedIoStatementState<Direction::Input>;
 
 int ExternalMiscIoStatementState::EndIoStatement() {
   ExternalFileUnit &ext{unit()};
@@ -742,6 +889,12 @@ InquireUnitState::InquireUnitState(
 
 bool InquireUnitState::Inquire(
     InquiryKeywordHash inquiry, char *result, std::size_t length) {
+  if (unit().createdForInternalChildIo()) {
+    SignalError(IostatInquireInternalUnit,
+        "INQUIRE of unit created for defined derived type I/O of an internal "
+        "unit");
+    return false;
+  }
   const char *str{nullptr};
   switch (inquiry) {
   case HashInquiryKeyword("ACCESS"):
@@ -1161,10 +1314,4 @@ InquireIOLengthState::InquireIOLengthState(
     const char *sourceFile, int sourceLine)
     : NoUnitIoStatementState{sourceFile, sourceLine, *this} {}
 
-bool InquireIOLengthState::Emit(
-    const char *, std::size_t n, std::size_t /*elementBytes*/) {
-  bytes_ += n;
-  return true;
-}
-
 } // namespace Fortran::runtime::io

flang/runtime/io-stmt.h

@@ -25,6 +25,7 @@
 namespace Fortran::runtime::io {
 
 class ExternalFileUnit;
+class ChildIo;
 
 class OpenStatementState;
 class InquireUnitState;
@@ -41,7 +42,10 @@ template <Direction, typename CHAR = char> class InternalListIoStatementState;
 template <Direction, typename CHAR = char>
 class ExternalFormattedIoStatementState;
 template <Direction> class ExternalListIoStatementState;
-template <Direction> class UnformattedIoStatementState;
+template <Direction> class ExternalUnformattedIoStatementState;
+template <Direction, typename CHAR = char> class ChildFormattedIoStatementState;
+template <Direction> class ChildListIoStatementState;
+template <Direction> class ChildUnformattedIoStatementState;
 
 struct InputStatementState {};
 struct OutputStatementState {};
@@ -60,17 +64,19 @@ public:
   // to interact with the state of the I/O statement in progress.
   // This design avoids virtual member functions and function pointers,
   // which may not have good support in some runtime environments.
-  std::optional<DataEdit> GetNextDataEdit(int = 1);
+  int EndIoStatement();
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
+  bool Emit(const char *, std::size_t, std::size_t elementBytes);
+  bool Emit(const char *, std::size_t);
+  bool Emit(const char16_t *, std::size_t chars);
+  bool Emit(const char32_t *, std::size_t chars);
+  bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
   std::optional<char32_t> GetCurrentChar(); // vacant after end of record
   bool AdvanceRecord(int = 1);
   void BackspaceRecord();
   void HandleRelativePosition(std::int64_t);
-  int EndIoStatement();
+  void HandleAbsolutePosition(std::int64_t); // for r* in list I/O
-  ConnectionState &GetConnectionState();
+  std::optional<DataEdit> GetNextDataEdit(int = 1);
-  IoErrorHandler &GetIoErrorHandler() const;
   ExternalFileUnit *GetExternalFileUnit() const; // null if internal unit
-  MutableModes &mutableModes();
   bool BeginReadingRecord();
   void FinishReadingRecord();
   bool Inquire(InquiryKeywordHash, char *, std::size_t);
@@ -78,6 +84,10 @@ public:
   bool Inquire(InquiryKeywordHash, std::int64_t, bool &); // PENDING=
   bool Inquire(InquiryKeywordHash, std::int64_t &);
 
+  MutableModes &mutableModes();
+  ConnectionState &GetConnectionState();
+  IoErrorHandler &GetIoErrorHandler() const;
+
   // N.B.: this also works with base classes
   template <typename A> A *get_if() const {
     return std::visit(
@@ -129,8 +139,18 @@ private:
           ExternalFormattedIoStatementState<Direction::Input>>,
       std::reference_wrapper<ExternalListIoStatementState<Direction::Output>>,
       std::reference_wrapper<ExternalListIoStatementState<Direction::Input>>,
-      std::reference_wrapper<UnformattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<
-      std::reference_wrapper<UnformattedIoStatementState<Direction::Input>>,
+          ExternalUnformattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<
+          ExternalUnformattedIoStatementState<Direction::Input>>,
+      std::reference_wrapper<ChildFormattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<ChildFormattedIoStatementState<Direction::Input>>,
+      std::reference_wrapper<ChildListIoStatementState<Direction::Output>>,
+      std::reference_wrapper<ChildListIoStatementState<Direction::Input>>,
+      std::reference_wrapper<
+          ChildUnformattedIoStatementState<Direction::Output>>,
+      std::reference_wrapper<
+          ChildUnformattedIoStatementState<Direction::Input>>,
       std::reference_wrapper<InquireUnitState>,
       std::reference_wrapper<InquireNoUnitState>,
       std::reference_wrapper<InquireUnconnectedFileState>,
@@ -140,18 +160,30 @@ private:
 };
 
 // Base class for all per-I/O statement state classes.
-// Inherits IoErrorHandler from its base.
+struct IoStatementBase : public IoErrorHandler {
-struct IoStatementBase : public DefaultFormatControlCallbacks {
+  using IoErrorHandler::IoErrorHandler;
-  using DefaultFormatControlCallbacks::DefaultFormatControlCallbacks;
+
+  // These are default no-op backstops that can be overridden by descendants.
   int EndIoStatement();
+  bool Emit(const char *, std::size_t, std::size_t elementBytes);
+  bool Emit(const char *, std::size_t);
+  bool Emit(const char16_t *, std::size_t chars);
+  bool Emit(const char32_t *, std::size_t chars);
+  bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
+  std::optional<char32_t> GetCurrentChar();
+  bool AdvanceRecord(int);
+  void BackspaceRecord();
+  void HandleRelativePosition(std::int64_t);
+  void HandleAbsolutePosition(std::int64_t);
   std::optional<DataEdit> GetNextDataEdit(IoStatementState &, int = 1);
-  ExternalFileUnit *GetExternalFileUnit() const { return nullptr; }
+  ExternalFileUnit *GetExternalFileUnit() const;
-  bool BeginReadingRecord() { return true; }
+  bool BeginReadingRecord();
-  void FinishReadingRecord() {}
+  void FinishReadingRecord();
   bool Inquire(InquiryKeywordHash, char *, std::size_t);
   bool Inquire(InquiryKeywordHash, bool &);
   bool Inquire(InquiryKeywordHash, std::int64_t, bool &);
   bool Inquire(InquiryKeywordHash, std::int64_t &);
+
   void BadInquiryKeywordHashCrash(InquiryKeywordHash);
 };
 
@@ -207,8 +239,11 @@ public:
   InternalIoStatementState(
       const Descriptor &, const char *sourceFile = nullptr, int sourceLine = 0);
   int EndIoStatement();
-  bool Emit(const CharType *, std::size_t chars /* not necessarily bytes */,
+
-      std::size_t elementBytes = 0);
+  using IoStatementBase::Emit;
+  bool Emit(
+      const CharType *data, std::size_t chars /* not necessarily bytes */);
+
   std::optional<char32_t> GetCurrentChar();
   bool AdvanceRecord(int = 1);
   void BackspaceRecord();
@@ -275,7 +310,7 @@ public:
   MutableModes &mutableModes();
   ConnectionState &GetConnectionState();
   int EndIoStatement();
-  ExternalFileUnit *GetExternalFileUnit() { return &unit_; }
+  ExternalFileUnit *GetExternalFileUnit() const { return &unit_; }
 
 private:
   ExternalFileUnit &unit_;
@@ -287,7 +322,8 @@ class ExternalIoStatementState : public ExternalIoStatementBase,
 public:
   using ExternalIoStatementBase::ExternalIoStatementBase;
   int EndIoStatement();
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
+  bool Emit(const char *, std::size_t, std::size_t elementBytes);
+  bool Emit(const char *, std::size_t);
   bool Emit(const char16_t *, std::size_t chars /* not bytes */);
   bool Emit(const char32_t *, std::size_t chars /* not bytes */);
   std::optional<char32_t> GetCurrentChar();
@@ -331,13 +367,73 @@ public:
 };
 
 template <Direction DIR>
-class UnformattedIoStatementState : public ExternalIoStatementState<DIR> {
+class ExternalUnformattedIoStatementState
+    : public ExternalIoStatementState<DIR> {
 public:
   using ExternalIoStatementState<DIR>::ExternalIoStatementState;
   bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
 };
 
+template <Direction DIR>
+class ChildIoStatementState : public IoStatementBase,
+                              public IoDirectionState<DIR> {
+public:
+  ChildIoStatementState(
+      ChildIo &, const char *sourceFile = nullptr, int sourceLine = 0);
+  ChildIo &child() { return child_; }
+  MutableModes &mutableModes();
+  ConnectionState &GetConnectionState();
+  ExternalFileUnit *GetExternalFileUnit() const;
+  int EndIoStatement();
+  bool Emit(const char *, std::size_t, std::size_t elementBytes);
+  bool Emit(const char *, std::size_t);
+  bool Emit(const char16_t *, std::size_t chars /* not bytes */);
+  bool Emit(const char32_t *, std::size_t chars /* not bytes */);
+  std::optional<char32_t> GetCurrentChar();
+  void HandleRelativePosition(std::int64_t);
+  void HandleAbsolutePosition(std::int64_t);
+
+private:
+  ChildIo &child_;
+};
+
+template <Direction DIR, typename CHAR>
+class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
+                                       public FormattedIoStatementState {
+public:
+  using CharType = CHAR;
+  ChildFormattedIoStatementState(ChildIo &, const CharType *format,
+      std::size_t formatLength, const char *sourceFile = nullptr,
+      int sourceLine = 0);
+  MutableModes &mutableModes() { return mutableModes_; }
+  int EndIoStatement();
+  bool AdvanceRecord(int = 1);
+  std::optional<DataEdit> GetNextDataEdit(
+      IoStatementState &, int maxRepeat = 1) {
+    return format_.GetNextDataEdit(*this, maxRepeat);
+  }
+
+private:
+  MutableModes mutableModes_;
+  FormatControl<ChildFormattedIoStatementState> format_;
+};
+
+template <Direction DIR>
+class ChildListIoStatementState : public ChildIoStatementState<DIR>,
+                                  public ListDirectedStatementState<DIR> {
+public:
+  using ChildIoStatementState<DIR>::ChildIoStatementState;
+  using ListDirectedStatementState<DIR>::GetNextDataEdit;
+};
+
+template <Direction DIR>
+class ChildUnformattedIoStatementState : public ChildIoStatementState<DIR> {
+public:
+  using ChildIoStatementState<DIR>::ChildIoStatementState;
+  bool Receive(char *, std::size_t, std::size_t elementBytes = 0);
+};
+
+// OPEN
 class OpenStatementState : public ExternalIoStatementBase {
 public:
   OpenStatementState(ExternalFileUnit &unit, bool wasExtant,
@@ -415,8 +511,17 @@ extern template class ExternalFormattedIoStatementState<Direction::Output>;
 extern template class ExternalFormattedIoStatementState<Direction::Input>;
 extern template class ExternalListIoStatementState<Direction::Output>;
 extern template class ExternalListIoStatementState<Direction::Input>;
-extern template class UnformattedIoStatementState<Direction::Output>;
+extern template class ExternalUnformattedIoStatementState<Direction::Output>;
-extern template class UnformattedIoStatementState<Direction::Input>;
+extern template class ExternalUnformattedIoStatementState<Direction::Input>;
+extern template class ChildIoStatementState<Direction::Output>;
+extern template class ChildIoStatementState<Direction::Input>;
+extern template class ChildFormattedIoStatementState<Direction::Output>;
+extern template class ChildFormattedIoStatementState<Direction::Input>;
+extern template class ChildListIoStatementState<Direction::Output>;
+extern template class ChildListIoStatementState<Direction::Input>;
+extern template class ChildUnformattedIoStatementState<Direction::Output>;
+extern template class ChildUnformattedIoStatementState<Direction::Input>;
+
 extern template class FormatControl<
     InternalFormattedIoStatementState<Direction::Output>>;
 extern template class FormatControl<
@@ -425,6 +530,10 @@ extern template class FormatControl<
     ExternalFormattedIoStatementState<Direction::Output>>;
 extern template class FormatControl<
     ExternalFormattedIoStatementState<Direction::Input>>;
+extern template class FormatControl<
+    ChildFormattedIoStatementState<Direction::Output>>;
+extern template class FormatControl<
+    ChildFormattedIoStatementState<Direction::Input>>;
 
 class InquireUnitState : public ExternalIoStatementBase {
 public:
@@ -463,7 +572,6 @@ class InquireIOLengthState : public NoUnitIoStatementState,
 public:
   InquireIOLengthState(const char *sourceFile = nullptr, int sourceLine = 0);
   std::size_t bytes() const { return bytes_; }
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
 
 private:
   std::size_t bytes_{0};

flang/runtime/tools.cpp

@@ -71,9 +71,11 @@ int IdentifyValue(
 void ToFortranDefaultCharacter(
     char *to, std::size_t toLength, const char *from) {
   std::size_t len{std::strlen(from)};
-  std::memcpy(to, from, std::max(toLength, len));
   if (len < toLength) {
+    std::memcpy(to, from, len);
     std::memset(to + len, ' ', toLength - len);
+  } else {
+    std::memcpy(to, from, toLength);
   }
 }
 

flang/runtime/type-info.cpp

@@ -82,6 +82,21 @@ const Component *DerivedType::FindDataComponent(
                   : 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);
+  for (std::size_t j{0}; j < n; ++j, specialDesc.IncrementSubscripts(at)) {
+    const SpecialBinding &special{*specialDesc.Element<SpecialBinding>(at)};
+    if (special.which() == which) {
+      return &special;
+    }
+  }
+  return nullptr;
+}
+
 static void DumpScalarCharacter(
     FILE *f, const Descriptor &desc, const char *what) {
   if (desc.raw().version == CFI_VERSION &&
@@ -103,7 +118,7 @@ FILE *DerivedType::Dump(FILE *f) const {
     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]));
+        static_cast<std::uintmax_t>(uints[j]));
     if (offset == offsetof(DerivedType, binding_)) {
       std::fputs(" <-- binding_\n", f);
     } else if (offset == offsetof(DerivedType, name_)) {
@@ -151,6 +166,15 @@ FILE *DerivedType::Dump(FILE *f) const {
     std::fputs("    bad descriptor: ", f);
     compDesc.Dump(f);
   }
+  const Descriptor &specialDesc{special()};
+  std::fprintf(
+      f, "\n  special descriptor (byteSize 0x%zx): ", special_.byteSize);
+  specialDesc.Dump(f);
+  std::size_t specials{specialDesc.Elements()};
+  for (std::size_t j{0}; j < specials; ++j) {
+    std::fprintf(f, "  [%3zd] ", j);
+    specialDesc.ZeroBasedIndexedElement<SpecialBinding>(j)->Dump(f);
+  }
   return f;
 }
 
@@ -174,4 +198,46 @@ FILE *Component::Dump(FILE *f) const {
   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:
+    std::fputs("    Assignment", f);
+    break;
+  case Which::ElementalAssignment:
+    std::fputs("    ElementalAssignment", f);
+    break;
+  case Which::Final:
+    std::fputs("    Final", f);
+    break;
+  case Which::ElementalFinal:
+    std::fputs("    ElementalFinal", f);
+    break;
+  case Which::AssumedRankFinal:
+    std::fputs("    AssumedRankFinal", f);
+    break;
+  case Which::ReadFormatted:
+    std::fputs("    ReadFormatted", f);
+    break;
+  case Which::ReadUnformatted:
+    std::fputs("    ReadUnformatted", f);
+    break;
+  case Which::WriteFormatted:
+    std::fputs("    WriteFormatted", f);
+    break;
+  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, "    proc: 0x%p\n", reinterpret_cast<void *>(proc_));
+  return f;
+}
+
 } // namespace Fortran::runtime::typeInfo

flang/runtime/type-info.h

@@ -20,81 +20,7 @@
 
 namespace Fortran::runtime::typeInfo {
 
-class Component;
+class DerivedType;
-
-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(); }
-
-  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
-
-  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
-
-  // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
-  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)
-
-  // This array of local data components includes the parent component.
-  // Components are in component order, not collation order of their names.
-  // It does not include procedure pointer components.
-  StaticDescriptor<1, true>
-      component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
-
-  // 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
-};
 
 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
 
@@ -177,7 +103,8 @@ struct ProcPtrComponent {
   ProcedurePointer procInitialization; // for Genre::Procedure
 };
 
-struct SpecialBinding {
+class SpecialBinding {
+public:
   enum class Which : std::uint8_t {
     None = 0,
     Assignment = 4,
@@ -189,13 +116,27 @@ struct SpecialBinding {
     ReadUnformatted = 17,
     WriteFormatted = 18,
     WriteUnformatted = 19
-  } which{Which::None};
+  };
+
+  Which which() const { return which_; }
+  int rank() const { return rank_; }
+  bool IsArgDescriptor(int zeroBasedArg) const {
+    return (isArgDescriptorSet_ >> zeroBasedArg) & 1;
+  }
+  template <typename PROC> PROC GetProc() const {
+    return reinterpret_cast<PROC>(proc_);
+  }
+
+  FILE *Dump(FILE *) const;
+
+private:
+  Which which_{Which::None};
 
   // Used for Which::Final only.  Which::Assignment always has rank 0, as
   // type-bound defined assignment for rank > 0 must be elemental
   // due to the required passed object dummy argument, which are scalar.
   // User defined derived type I/O is always scalar.
-  std::uint8_t rank{0};
+  std::uint8_t rank_{0};
 
   // The following little bit-set identifies which dummy arguments are
   // passed via descriptors for their derived type arguments.
@@ -222,9 +163,86 @@ struct SpecialBinding {
   //     the case when and only when the derived type is extensible.
   //     When false, the user derived type I/O subroutine must have been
   //     called via a generic interface, not a generic TBP.
-  std::uint8_t isArgDescriptorSet{0};
+  std::uint8_t isArgDescriptorSet_{0};
 
-  ProcedurePointer proc{nullptr};
+  ProcedurePointer proc_{nullptr};
 };
+
+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(); }
+
+  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;
+
+  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
+
+  // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
+  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)
+
+  // This array of local data components includes the parent component.
+  // Components are in component order, not collation order of their names.
+  // It does not include procedure pointer components.
+  StaticDescriptor<1, true>
+      component_; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
+
+  // 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
+};
+
 } // namespace Fortran::runtime::typeInfo
 #endif // FORTRAN_RUNTIME_TYPE_INFO_H_

flang/runtime/unit-map.cpp

@@ -92,4 +92,5 @@ ExternalFileUnit &UnitMap::Create(int n, const Terminator &terminator) {
   bucket_[Hash(n)].swap(chain.next); // pushes new node as list head
   return chain.unit;
 }
+
 } // namespace Fortran::runtime::io

flang/runtime/unit.cpp

@@ -87,8 +87,11 @@ ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
   return GetUnitMap().LookUpForClose(unit);
 }
 
-int ExternalFileUnit::NewUnit(const Terminator &terminator) {
+ExternalFileUnit &ExternalFileUnit::NewUnit(
-  return GetUnitMap().NewUnit(terminator).unitNumber();
+    const Terminator &terminator, bool forChildIo) {
+  ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
+  unit.createdForInternalChildIo_ = forChildIo;
+  return unit;
 }
 
 void ExternalFileUnit::OpenUnit(std::optional<OpenStatus> status,
@@ -697,4 +700,43 @@ void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) {
   BeginRecord();
   impliedEndfile_ = false;
 }
+
+ChildIo &ExternalFileUnit::PushChildIo(IoStatementState &parent) {
+  OwningPtr<ChildIo> current{std::move(child_)};
+  Terminator &terminator{parent.GetIoErrorHandler()};
+  OwningPtr<ChildIo> next{New<ChildIo>{terminator}(parent, std::move(current))};
+  child_.reset(next.release());
+  return *child_;
+}
+
+void ExternalFileUnit::PopChildIo(ChildIo &child) {
+  if (child_.get() != &child) {
+    child.parent().GetIoErrorHandler().Crash(
+        "ChildIo being popped is not top of stack");
+  }
+  child_.reset(child.AcquirePrevious().release()); // deletes top child
+}
+
+void ChildIo::EndIoStatement() {
+  io_.reset();
+  u_.emplace<std::monostate>();
+}
+
+bool ChildIo::CheckFormattingAndDirection(Terminator &terminator,
+    const char *what, bool unformatted, Direction direction) {
+  bool parentIsUnformatted{!parent_.get_if<FormattedIoStatementState>()};
+  bool parentIsInput{!parent_.get_if<IoDirectionState<Direction::Output>>()};
+  if (unformatted != parentIsUnformatted) {
+    terminator.Crash("Child %s attempted on %s parent I/O unit", what,
+        parentIsUnformatted ? "unformatted" : "formatted");
+    return false;
+  } else if (parentIsInput != (direction == Direction::Input)) {
+    terminator.Crash("Child %s attempted on %s parent I/O unit", what,
+        parentIsInput ? "input" : "output");
+    return false;
+  } else {
+    return true;
+  }
+}
+
 } // namespace Fortran::runtime::io

flang/runtime/unit.h

@@ -28,6 +28,7 @@
 namespace Fortran::runtime::io {
 
 class UnitMap;
+class ChildIo;
 
 class ExternalFileUnit : public ConnectionState,
                          public OpenFile,
@@ -36,6 +37,7 @@ public:
   explicit ExternalFileUnit(int unitNumber) : unitNumber_{unitNumber} {}
   int unitNumber() const { return unitNumber_; }
   bool swapEndianness() const { return swapEndianness_; }
+  bool createdForInternalChildIo() const { return createdForInternalChildIo_; }
 
   static ExternalFileUnit *LookUp(int unit);
   static ExternalFileUnit &LookUpOrCrash(int unit, const Terminator &);
@@ -46,7 +48,7 @@ public:
   static ExternalFileUnit *LookUp(const char *path);
   static ExternalFileUnit &CreateNew(int unit, const Terminator &);
   static ExternalFileUnit *LookUpForClose(int unit);
-  static int NewUnit(const Terminator &);
+  static ExternalFileUnit &NewUnit(const Terminator &, bool forChildIo = false);
   static void CloseAll(IoErrorHandler &);
   static void FlushAll(IoErrorHandler &);
 
@@ -62,7 +64,6 @@ public:
 
   template <typename A, typename... X>
   IoStatementState &BeginIoStatement(X &&...xs) {
-    // TODO: Child data transfer statements vs. locking
     lock_.Take(); // dropped in EndIoStatement()
     A &state{u_.emplace<A>(std::forward<X>(xs)...)};
     if constexpr (!std::is_same_v<A, OpenStatementState>) {
@@ -91,6 +92,10 @@ public:
     BeginRecord();
   }
 
+  ChildIo *GetChildIo() { return child_.get(); }
+  ChildIo &PushChildIo(IoStatementState &);
+  void PopChildIo(ChildIo &);
+
 private:
   static UnitMap &GetUnitMap();
   const char *FrameNextInput(IoErrorHandler &, std::size_t);
@@ -116,8 +121,8 @@ private:
       ExternalFormattedIoStatementState<Direction::Input>,
       ExternalListIoStatementState<Direction::Output>,
       ExternalListIoStatementState<Direction::Input>,
-      UnformattedIoStatementState<Direction::Output>,
+      ExternalUnformattedIoStatementState<Direction::Output>,
-      UnformattedIoStatementState<Direction::Input>, InquireUnitState,
+      ExternalUnformattedIoStatementState<Direction::Input>, InquireUnitState,
       ExternalMiscIoStatementState>
       u_;
 
@@ -132,6 +137,50 @@ private:
   std::size_t recordOffsetInFrame_{0}; // of currentRecordNumber
 
   bool swapEndianness_{false};
+
+  bool createdForInternalChildIo_{false};
+
+  // A stack of child I/O pseudo-units for user-defined derived type
+  // I/O that have this unit number.
+  OwningPtr<ChildIo> child_;
+};
+
+// A pseudo-unit for child I/O statements in user-defined derived type
+// I/O subroutines; it forwards operations to the parent I/O statement,
+// which can also be a child I/O statement.
+class ChildIo {
+public:
+  ChildIo(IoStatementState &parent, OwningPtr<ChildIo> &&previous)
+      : parent_{parent}, previous_{std::move(previous)} {}
+
+  IoStatementState &parent() const { return parent_; }
+
+  void EndIoStatement();
+
+  template <typename A, typename... X>
+  IoStatementState &BeginIoStatement(X &&...xs) {
+    A &state{u_.emplace<A>(std::forward<X>(xs)...)};
+    io_.emplace(state);
+    return *io_;
+  }
+
+  OwningPtr<ChildIo> AcquirePrevious() { return std::move(previous_); }
+
+  bool CheckFormattingAndDirection(
+      Terminator &, const char *what, bool unformatted, Direction);
+
+private:
+  IoStatementState &parent_;
+  OwningPtr<ChildIo> previous_;
+  std::variant<std::monostate,
+      ChildFormattedIoStatementState<Direction::Output>,
+      ChildFormattedIoStatementState<Direction::Input>,
+      ChildListIoStatementState<Direction::Output>,
+      ChildListIoStatementState<Direction::Input>,
+      ChildUnformattedIoStatementState<Direction::Output>,
+      ChildUnformattedIoStatementState<Direction::Input>>
+      u_;
+  std::optional<IoStatementState> io_;
 };
 
 } // namespace Fortran::runtime::io

flang/test/Semantics/typeinfo01.f90

@@ -171,7 +171,7 @@ module m09
 end module
 
 module m10
-  type :: t
+  type, bind(c) :: t ! non-extensible
   end type
   interface read(formatted)
     procedure :: rf