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

[klausler]

Summary

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.

[klausler]

Rebased to current llvm-project/main.

[jeanPerier]

Code looks great to me !

flang/runtime/io-stmt.cpp

30

These 3 pre-merge checks warning also look applicable in f18 coding style context.

flang/include/flang/Common/format.h

private:
   const CHAR *const format_; // format text
   const CHAR *const end_; // one-past-last of format_ text
   Reporter reporter_;
   IoStmtKind stmt_;
 
   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};
   bool suppressMessageCascade_{false};
   bool reporterExit_{false};
   int maxNesting_{0}; // max level of nested parentheses
 };
 
template <typename CHAR> void FormatValidator<CHAR>::Advance(TokenKind tk) {
   cursor_ = laCursor_;
   token_.set_kind(tk);
 }
 
 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_);
   token_.set_length(1);
   if (c == '_' && integerValue_ >= 0) { // C1305, C1309, C1310, C1312, C1313
     ReportError("Kind parameter '_' character in format expression");
   }
   integerValue_ = -1;
for (++cursor_; cursor_ < end_; ++cursor_) {
         if (auto nc{cursor_ + 1}; nc < end_ && *nc != c) {
           token_.set_kind(TokenKind::String);
           break;
         }
         ++cursor_;
       }
     }
     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");
     }
     break;
   default:
     if (cursor_ >= end_ && !unterminatedFormatError_) {
       suppressMessageCascade_ = false;
case TokenKind::None: // Error; token not yet processed.
       if (cursor_ >= end_) {
         return formatHasErrors_; // incomplete format error exit
       }
       break;
     default:
       // 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);
         }
       }
     }
   }
 
   return formatHasErrors_; // error reporter (message threshold) exit
 }
 
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORMAT_H_

flang/lib/Semantics/check-declarations.cpp

void CheckHelper::CheckAlreadySeenDefinedIo(const DerivedTypeSpec *derivedType,
   }
   seenDefinedIoTypes_.emplace_back(
       TypeWithDefinedIo{derivedType, ioKind, proc});
 }
 
 void CheckHelper::CheckDioDummyIsDerived(
     const Symbol &subp, const Symbol &arg, GenericKind::DefinedIo ioKind) {
   if (const DeclTypeSpec * type{arg.GetType()}) {
-    const DerivedTypeSpec *derivedType{type->AsDerived()};
-    if (derivedType) {
+    if (const DerivedTypeSpec * derivedType{type->AsDerived()}) {
       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"
           " derived type"_err_en_US,
           arg.name());
     }
   }
 }

flang/runtime/CMakeLists.txt

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

flang/runtime/derived.cpp

 static const typeInfo::SpecialBinding *FindFinal(
     const typeInfo::DerivedType &derived, int rank) {
   const typeInfo::SpecialBinding *elemental{nullptr};
   const Descriptor &specialDesc{derived.special()};
   std::size_t totalSpecialBindings{specialDesc.Elements()};
   for (std::size_t j{0}; j < totalSpecialBindings; ++j) {
     const auto &special{
         *specialDesc.ZeroBasedIndexedElement<typeInfo::SpecialBinding>(j)};
-    switch (special.which) {
+    switch (special.which()) {
     case typeInfo::SpecialBinding::Which::Final:
-      if (special.rank == rank) {
+      if (special.rank() == rank) {
         return &special;
       }
       break;
     case typeInfo::SpecialBinding::Which::ElementalFinal:
       elemental = &special;
       break;
     case typeInfo::SpecialBinding::Which::AssumedRankFinal:
       return &special;
     default:;
     }
   }
   return elemental;
 }
 
 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) {
-      auto p{reinterpret_cast<void (*)(const Descriptor &)>(special->proc)};
+    } else if (special->IsArgDescriptor(0)) {
+      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>());
     }
   }
 }
 
 // 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.

flang/runtime/descriptor-io.h

 //===-- runtime/descriptor-io.h ---------------------------------*- C++ -*-===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 
 #ifndef FORTRAN_RUNTIME_DESCRIPTOR_IO_H_
 #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"
 #include "edit-input.h"
 #include "edit-output.h"
 #include "io-stmt.h"
 #include "terminator.h"
 #include "type-info.h"
+#include "unit.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) {
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);
   }
 }
 
+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);
-  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;
-        }
-      }
-    }
-  }
+  RUNTIME_CHECK(handler, type != nullptr);
+  if (const typeInfo::SpecialBinding *
+      special{type->FindSpecialBinding(DIR == Direction::Input
+              ? typeInfo::SpecialBinding::Which::ReadFormatted
+              : typeInfo::SpecialBinding::Which::WriteFormatted)}) {
+    if (std::optional<bool> wasDefined{
+            DefinedFormattedIo(io, descriptor, *special)}) {
+      return *wasDefined; // user-defined I/O was applied
+    }
+  }
+  // Default componentwise derived type formatting
+  RUNTIME_CHECK(handler, compArray.rank() == 1);
+              io, component, descriptor, subscripts, handler)) {
   return true;
 }
 
+bool DefinedUnformattedIo(
+    IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
+
+// Unformatted I/O
 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>>()}) {
+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);
-    std::size_t numElements{descriptor.Elements()};
-    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};
+    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 unf->Emit(&x, totalBytes, elementBytes);
+        return externalUnf ? externalUnf->Emit(&x, totalBytes, elementBytes)
+                           : childUnf->Emit(&x, totalBytes, elementBytes);
       } else {
-        return unf->Receive(&x, totalBytes, elementBytes);
+        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 constexpr (DIR == Direction::Output) {
-          if (!unf->Emit(&x, elementBytes, elementBytes)) {
-            return false;
-          }
-        } else {
-          if (!unf->Receive(&x, elementBytes, elementBytes)) {
-            return false;
-          }
-        }
+        if (!Transfer(x, elementBytes, elementBytes)) {
         if (!descriptor.IncrementSubscripts(subscripts) &&
             j + 1 < numElements) {
-          io.GetIoErrorHandler().Crash(
-              "DescriptorIO: subscripts out of bounds");
+          handler.Crash("DescriptorIO: subscripts out of bounds");
         }
       }
       return true;
     }
-  } else if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
+  }
+}
+
+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 (!io.get_if<FormattedIoStatementState>()) {
+    return UnformattedDescriptorIO<DIR>(io, descriptor);
+  }
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  if (auto catAndKind{descriptor.type().GetCategoryAndKind()}) {
+    TypeCategory cat{catAndKind->first};
     int kind{catAndKind->second};
-    switch (catAndKind->first) {
+    switch (cat) {
     case TypeCategory::Integer:
       switch (kind) {
       case 1:
         return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 1>, DIR>(
             io, descriptor);
       case 2:
         return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 2>, DIR>(
             io, descriptor);
       case 4:
         return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 4>, DIR>(
             io, descriptor);
       case 8:
         return FormattedIntegerIO<CppTypeFor<TypeCategory::Integer, 8>, DIR>(
             io, descriptor);
       case 16:
         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;
       }
     case TypeCategory::Real:
       switch (kind) {
       case 2:
         return FormattedRealIO<2, DIR>(io, descriptor);
       case 3:
         return FormattedRealIO<3, DIR>(io, descriptor);
       case 4:
         return FormattedRealIO<4, DIR>(io, descriptor);
       case 8:
         return FormattedRealIO<8, DIR>(io, descriptor);
       case 10:
         return FormattedRealIO<10, DIR>(io, descriptor);
       // TODO: case double/double
       case 16:
         return FormattedRealIO<16, DIR>(io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented REAL kind (%d) in descriptor", kind);
         return false;
       }
     case TypeCategory::Complex:
       switch (kind) {
       case 2:
         return FormattedComplexIO<2, DIR>(io, descriptor);
       case 3:
         return FormattedComplexIO<3, DIR>(io, descriptor);
       case 4:
         return FormattedComplexIO<4, DIR>(io, descriptor);
       case 8:
         return FormattedComplexIO<8, DIR>(io, descriptor);
       case 10:
         return FormattedComplexIO<10, DIR>(io, descriptor);
       // TODO: case double/double
       case 16:
         return FormattedComplexIO<16, DIR>(io, descriptor);
       default:
-        io.GetIoErrorHandler().Crash(
+        handler.Crash(
             "DescriptorIO: Unimplemented COMPLEX kind (%d) in descriptor",
             kind);
         return false;
       }
     case TypeCategory::Character:
       switch (kind) {
       case 1:
         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;
       }
     case TypeCategory::Logical:
       switch (kind) {
       case 1:
         return FormattedLogicalIO<CppTypeFor<TypeCategory::Integer, 1>, DIR>(
             io, descriptor);
       case 2:
         return FormattedLogicalIO<CppTypeFor<TypeCategory::Integer, 2>, DIR>(
             io, descriptor);
       case 4:
         return FormattedLogicalIO<CppTypeFor<TypeCategory::Integer, 4>, DIR>(
             io, descriptor);
       case 8:
         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;
       }
     case TypeCategory::Derived:
       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;
 }
 } // namespace Fortran::runtime::io::descr
 #endif // FORTRAN_RUNTIME_DESCRIPTOR_IO_H_

flang/runtime/descriptor-io.cpp

+//===-- 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/format-implementation.h

if (ch == '(') {
       CharType next{'\0'};
       if (ch != 'P') { // 1PE5.2 - comma not required (C1302)
         CharType peek{Capitalize(PeekNext())};
         if (peek >= 'A' && peek <= 'Z') {
           next = peek;
           ++offset_;
         }
       }
-      if (ch == 'E' ||
-          (!next &&
-              (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'O' || ch == 'Z' ||
-                  ch == 'F' || ch == 'D' || ch == 'G' || ch == 'L'))) {
+      if ((!next &&
+              (ch == 'A' || ch == 'I' || ch == 'B' || ch == 'E' || ch == 'D' ||
+                  ch == 'O' || ch == 'Z' || ch == 'F' || ch == 'G' ||
+                  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;
       } else {
         // Control edit descriptor
         if (ch == 'T') { // Tn, TLn, TRn
           repeat = GetIntField(context);
         }
         HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
             repeat ? *repeat : 1);
       }
     } else if (ch == '/') {
       context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
     } else {
       context.SignalError(IostatErrorInFormat,
           "Invalid character '%c' in FORMAT", static_cast<char>(ch));
       return 0;
     }
   }
 }
 
+// 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 (edit.variation >= 'A' && edit.variation <= 'Z') {
+    if (auto next{static_cast<char>(Capitalize(PeekNext()))};
+        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 (PeekNext() == '.') {
+  if (edit.descriptor != DataEdit::DefinedDerivedType && PeekNext() == '.') {
     ++offset_;
     edit.digits = GetIntField(context);
     CharType ch{PeekNext()};
     if (ch == 'e' || ch == 'E' || ch == 'd' || ch == 'D') {
       ++offset_;
       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] != '(') {
       if (stack_[height_ - 1].remaining > maxRepeat) {
         edit.repeat = maxRepeat;
         stack_[height_ - 1].remaining -= maxRepeat;
         offset_ = start; // repeat same edit descriptor next time
       } else {

flang/runtime/format.h

struct DataEdit {
   static constexpr char ListDirectedRealPart{'r'}; // emit "(r," or "(r;"
   static constexpr char ListDirectedImaginaryPart{'z'}; // emit "z)"
   static constexpr char ListDirectedNullValue{'n'}; // see 13.10.3.2
   constexpr bool IsListDirected() const {
     return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
         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;
-// these default implementations just crash if called.
-struct DefaultFormatControlCallbacks : public IoErrorHandler {
-  using IoErrorHandler::IoErrorHandler;
-  DataEdit GetNextDataEdit(int = 1);
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
-  bool Emit(const char16_t *, std::size_t);
-  bool Emit(const char32_t *, std::size_t);
-  std::optional<char32_t> GetCurrentChar();
-  bool AdvanceRecord(int = 1);
-  void BackspaceRecord();
-  void HandleAbsolutePosition(std::int64_t);
-  void HandleRelativePosition(std::int64_t);
+  // "iotype" &/or "v_list" values for a DT'iotype'(v_list)
+  // user-defined derived type data edit descriptor
+  static constexpr std::size_t maxIoTypeChars{32};
+  static constexpr std::size_t maxVListEntries{4};
+  std::uint8_t ioTypeChars{0};
+  std::uint8_t vListEntries{0};
+  char ioType[maxIoTypeChars];
+  int vList[maxVListEntries];
 };
 
 // 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;
   using CharType = typename Context::CharType;
 
   FormatControl() {}
   FormatControl(const Terminator &, const CharType *format,
       std::size_t formatLength, int maxHeight = maxMaxHeight);
 
   // Determines the max parenthesis nesting level by scanning and validating
   // the FORMAT string.
   static int GetMaxParenthesisNesting(
       IoErrorHandler &, const CharType *format, std::size_t formatLength);
 
   // For attempting to allocate in a user-supplied stack area
   static std::size_t GetNeededSize(int maxHeight) {
     return sizeof(FormatControl) -
         sizeof(Iteration) * (maxMaxHeight - maxHeight);
   }
 
   // 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)
   // and perform remaining record positioning actions.
   void Finish(Context &);
 
 private:
   static constexpr std::uint8_t maxMaxHeight{100};

flang/runtime/format.cpp

 //===-- runtime/format.cpp --------------------------------------*- C++ -*-===//
 //
 // 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 "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<
     InternalFormattedIoStatementState<Direction::Input>>;
 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/io-api.cpp

 Cookie BeginExternalListIO(const char *what, int unitNumber,
     const char *sourceFile, int sourceLine, A &&...xs) {
   Terminator terminator{sourceFile, sourceLine};
   if (unitNumber == DefaultUnit) {
     unitNumber = DIR == Direction::Input ? 5 : 6;
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
+  if (ChildIo * child{unit.GetChildIo()}) {
+    return child->CheckFormattingAndDirection(terminator, what, false, DIR)
+        ? &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;
   }
+}
 
 Cookie IONAME(BeginExternalListOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginExternalListIO<Direction::Output, ExternalListIoStatementState>(
       "List-directed output", unitNumber, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginExternalListInput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginExternalListIO<Direction::Input, ExternalListIoStatementState>(
       "List-directed input", unitNumber, sourceFile, sourceLine);
 }
 
 template <Direction DIR>
 Cookie BeginExternalFormattedIO(const char *format, std::size_t formatLength,
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   if (unitNumber == DefaultUnit) {
     unitNumber = DIR == Direction::Input ? 5 : 6;
   }
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, false /*!unformatted*/, terminator)};
+  if (ChildIo * child{unit.GetChildIo()}) {
+    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;
   }
+}
 
 Cookie IONAME(BeginExternalFormattedOutput)(const char *format,
     std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
     int sourceLine) {
   return BeginExternalFormattedIO<Direction::Output>(
       format, formatLength, unitNumber, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginExternalFormattedInput)(const char *format,
     std::size_t formatLength, ExternalUnit unitNumber, const char *sourceFile,
     int sourceLine) {
   return BeginExternalFormattedIO<Direction::Input>(
       format, formatLength, unitNumber, sourceFile, sourceLine);
 }
 
 template <Direction DIR>
 Cookie BeginUnformattedIO(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
   ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreateAnonymous(
       unitNumber, DIR, true /*unformatted*/, terminator)};
+  if (ChildIo * child{unit.GetChildIo()}) {
+    return child->CheckFormattingAndDirection(terminator,
+               DIR == Direction::Output ? "unformatted output"
+                                        : "unformatted input",
+               true, DIR)
+        ? &child->BeginIoStatement<ChildUnformattedIoStatementState<DIR>>(
+              *child, sourceFile, sourceLine)
+        : nullptr;
+  } else {
     if (!unit.isUnformatted.has_value()) {
       unit.isUnformatted = true;
     }
     if (!*unit.isUnformatted) {
       terminator.Crash("Unformatted I/O attempted on formatted file");
     }
-  IoStatementState &io{unit.BeginIoStatement<UnformattedIoStatementState<DIR>>(
+    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
-      // UnformattedIoStatementState<Direction::Output>::EndIoStatement()
+        // 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;
   }
+}
 
 Cookie IONAME(BeginUnformattedOutput)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   return BeginUnformattedIO<Direction::Output>(
       unitNumber, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginUnformattedInput)(
ExternalFileUnit &unit{
       ExternalFileUnit::LookUpOrCreate(unitNumber, terminator, wasExtant)};
   return &unit.BeginIoStatement<OpenStatementState>(
       unit, wasExtant, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginOpenNewUnit)( // OPEN(NEWUNIT=j)
     const char *sourceFile, int sourceLine) {
   Terminator terminator{sourceFile, sourceLine};
-  bool ignored{false};
-  ExternalFileUnit &unit{ExternalFileUnit::LookUpOrCreate(
-      ExternalFileUnit::NewUnit(terminator), terminator, ignored)};
+  ExternalFileUnit &unit{ExternalFileUnit::NewUnit(terminator)};
   return &unit.BeginIoStatement<OpenStatementState>(
       unit, false /*was an existing file*/, sourceFile, sourceLine);
 }
 
 Cookie IONAME(BeginClose)(
     ExternalUnit unitNumber, const char *sourceFile, int sourceLine) {
   if (ExternalFileUnit * unit{ExternalFileUnit::LookUpForClose(unitNumber)}) {
     return &unit->BeginIoStatement<CloseStatementState>(

 
 bool IONAME(InputDescriptor)(Cookie cookie, const Descriptor &descriptor) {
   return descr::DescriptorIO<Direction::Input>(*cookie, 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 "
                                "statement that is not unformatted output");
   return false;
 }
 
 bool IONAME(InputUnformattedBlock)(
     Cookie cookie, char *x, std::size_t length, std::size_t elementBytes) {
   IoStatementState &io{*cookie};
   io.BeginReadingRecord();
   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 "
                                "statement that is not unformatted output");
   return false;
 }
 
 bool IONAME(OutputInteger64)(Cookie cookie, std::int64_t n) {

flang/runtime/io-error.h

 public:
   using Terminator::Terminator;
   explicit IoErrorHandler(const Terminator &that) : Terminator{that} {}
   void HasIoStat() { flags_ |= hasIoStat; }
   void HasErrLabel() { flags_ |= hasErr; }
   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; }
 
   void SignalError(int iostatOrErrno, const char *msg, ...);
   void SignalError(int iostatOrErrno);
   template <typename... X> void SignalError(const char *msg, X &&...xs) {
     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
 
   int GetIoStat() const { return ioStat_; }
   bool GetIoMsg(char *, std::size_t);
 
 private:

flang/runtime/io-error.cpp

if (iostatOrErrno == IostatEnd && (flags_ & hasEnd)) {
     }
   }
 }
 
 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); }
 
 void IoErrorHandler::SignalEor() { SignalError(IostatEor); }
 
 bool IoErrorHandler::GetIoMsg(char *buffer, std::size_t bufferLength) {
   const char *msg{ioMsg_.get()};

flang/runtime/io-stmt.h

 #include "io-error.h"
 #include <functional>
 #include <type_traits>
 #include <variant>
 
 namespace Fortran::runtime::io {
 
 class ExternalFileUnit;
+class ChildIo;
 
 class OpenStatementState;
 class InquireUnitState;
 class InquireNoUnitState;
 class InquireUnconnectedFileState;
 class InquireIOLengthState;
 class ExternalMiscIoStatementState;
 class CloseStatementState;
 class NoopCloseStatementState;
 
 template <Direction, typename CHAR = char>
 class InternalFormattedIoStatementState;
 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 {};
 template <Direction D>
 using IoDirectionState = std::conditional_t<D == Direction::Input,
     InputStatementState, OutputStatementState>;
 struct FormattedIoStatementState {};
 
 // The Cookie type in the I/O API is a pointer (for C) to this class.
 class IoStatementState {
 public:
   template <typename A> explicit IoStatementState(A &x) : u_{x} {}
 
   // These member functions each project themselves into the active alternative.
   // They're used by per-data-item routines in the I/O API (e.g., OutputReal64)
   // 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);
-  bool Emit(const char *, std::size_t, std::size_t elementBytes = 0);
+  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(); // vacant after end of record
   bool AdvanceRecord(int = 1);
   void BackspaceRecord();
   void HandleRelativePosition(std::int64_t);
-  int EndIoStatement();
-  ConnectionState &GetConnectionState();
-  IoErrorHandler &GetIoErrorHandler() const;
+  void HandleAbsolutePosition(std::int64_t); // for r* in list I/O
+  std::optional<DataEdit> GetNextDataEdit(int = 1);
   ExternalFileUnit *GetExternalFileUnit() const; // null if internal unit
-  MutableModes &mutableModes();
   bool BeginReadingRecord();
   void FinishReadingRecord();
   bool Inquire(InquiryKeywordHash, char *, std::size_t);
   bool Inquire(InquiryKeywordHash, bool &);
   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(
         [](auto &x) -> A * {
           if constexpr (std::is_convertible_v<decltype(x.get()), A &>) {
             return &x.get();
           }
           return nullptr;
std::variant<std::reference_wrapper<OpenStatementState>,
       std::reference_wrapper<InternalListIoStatementState<Direction::Output>>,
       std::reference_wrapper<InternalListIoStatementState<Direction::Input>>,
       std::reference_wrapper<
           ExternalFormattedIoStatementState<Direction::Output>>,
       std::reference_wrapper<
           ExternalFormattedIoStatementState<Direction::Input>>,
       std::reference_wrapper<ExternalListIoStatementState<Direction::Output>>,
       std::reference_wrapper<ExternalListIoStatementState<Direction::Input>>,
-      std::reference_wrapper<UnformattedIoStatementState<Direction::Output>>,
-      std::reference_wrapper<UnformattedIoStatementState<Direction::Input>>,
+      std::reference_wrapper<
+          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>,
       std::reference_wrapper<InquireIOLengthState>,
       std::reference_wrapper<ExternalMiscIoStatementState>>
       u_;
 };
 
 // Base class for all per-I/O statement state classes.
-// Inherits IoErrorHandler from its base.
-struct IoStatementBase : public DefaultFormatControlCallbacks {
-  using DefaultFormatControlCallbacks::DefaultFormatControlCallbacks;
+struct IoStatementBase : public IoErrorHandler {
+  using IoErrorHandler::IoErrorHandler;
+
+  // 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; }
-  bool BeginReadingRecord() { return true; }
-  void FinishReadingRecord() {}
+  ExternalFileUnit *GetExternalFileUnit() const;
+  bool BeginReadingRecord();
+  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);
 };
 
 // Common state for list-directed & NAMELIST I/O, both internal & external
 template <Direction> class ListDirectedStatementState;
 template <>
 class ListDirectedStatementState<Direction::Output>
     : public FormattedIoStatementState {
public:
   using CharType = CHAR;
   using Buffer =
       std::conditional_t<DIR == Direction::Input, const CharType *, CharType *>;
   InternalIoStatementState(Buffer, std::size_t,
       const char *sourceFile = nullptr, int sourceLine = 0);
   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();
   ConnectionState &GetConnectionState() { return unit_; }
   MutableModes &mutableModes() { return unit_.modes; }
   void HandleRelativePosition(std::int64_t);
   void HandleAbsolutePosition(std::int64_t);
 

 class ExternalIoStatementBase : public IoStatementBase {
 public:
   ExternalIoStatementBase(
       ExternalFileUnit &, const char *sourceFile = nullptr, int sourceLine = 0);
   ExternalFileUnit &unit() { return unit_; }
   MutableModes &mutableModes();
   ConnectionState &GetConnectionState();
   int EndIoStatement();
-  ExternalFileUnit *GetExternalFileUnit() { return &unit_; }
+  ExternalFileUnit *GetExternalFileUnit() const { return &unit_; }
 
 private:
   ExternalFileUnit &unit_;
 };
 
 template <Direction DIR>
 class ExternalIoStatementState : public ExternalIoStatementBase,
                                  public IoDirectionState<DIR> {
 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();
   bool AdvanceRecord(int = 1);
   void BackspaceRecord();
   void HandleRelativePosition(std::int64_t);
   void HandleAbsolutePosition(std::int64_t);
   bool BeginReadingRecord();

 class ExternalListIoStatementState : public ExternalIoStatementState<DIR>,
                                      public ListDirectedStatementState<DIR> {
 public:
   using ExternalIoStatementState<DIR>::ExternalIoStatementState;
   using ListDirectedStatementState<DIR>::GetNextDataEdit;
 };
 
 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,
       const char *sourceFile = nullptr, int sourceLine = 0)
       : ExternalIoStatementBase{unit, sourceFile, sourceLine}, wasExtant_{
                                                                    wasExtant} {}
   bool wasExtant() const { return wasExtant_; }
   void set_status(OpenStatus status) { status_ = status; } // STATUS=

 extern template class InternalListIoStatementState<Direction::Output>;
 extern template class InternalListIoStatementState<Direction::Input>;
 extern template class ExternalIoStatementState<Direction::Output>;
 extern template class ExternalIoStatementState<Direction::Input>;
 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 UnformattedIoStatementState<Direction::Input>;
+extern template class ExternalUnformattedIoStatementState<Direction::Output>;
+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<
     InternalFormattedIoStatementState<Direction::Input>>;
 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:
   InquireUnitState(ExternalFileUnit &unit, const char *sourceFile = nullptr,
       int sourceLine = 0);
   bool Inquire(InquiryKeywordHash, char *, std::size_t);
   bool Inquire(InquiryKeywordHash, bool &);
   bool Inquire(InquiryKeywordHash, std::int64_t, bool &);
private:
   OwningPtr<char> path_; // trimmed and NUL terminated
 };
 
 class InquireIOLengthState : public NoUnitIoStatementState,
                              public OutputStatementState {
 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};
 };
 
 class ExternalMiscIoStatementState : public ExternalIoStatementBase {
 public:
   enum Which { Flush, Backspace, Endfile, Rewind };

flang/runtime/io-stmt.cpp

 #include <cstdio>
 #include <cstring>
 #include <limits>
 
 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;
 }
 
 void IoStatementBase::BadInquiryKeywordHashCrash(InquiryKeywordHash inquiry) {
   char buffer[16];
   const char *decode{InquiryKeywordHashDecode(buffer, sizeof buffer, inquiry)};
   Crash("bad InquiryKeywordHash 0x%x (%s)", inquiry,
       decode ? decode : "(cannot decode)");
 }
 
 template <Direction DIR, typename CHAR>
 InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
     Buffer scalar, std::size_t length, const char *sourceFile, int sourceLine)
     : IoStatementBase{sourceFile, sourceLine}, unit_{scalar, length} {}
 
 template <Direction DIR, typename CHAR>
 InternalIoStatementState<DIR, CHAR>::InternalIoStatementState(
     const Descriptor &d, const char *sourceFile, int sourceLine)
     : IoStatementBase{sourceFile, sourceLine}, unit_{d, *this} {}
 
 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>
 std::optional<char32_t> InternalIoStatementState<DIR, CHAR>::GetCurrentChar() {
   if constexpr (DIR == Direction::Output) {
     Crash(
         "InternalIoStatementState<Direction::Output>::GetCurrentChar() called");
     return std::nullopt;
bool ExternalIoStatementState<DIR>::Emit(
     const char *data, std::size_t bytes, std::size_t elementBytes) {
   if constexpr (DIR == Direction::Input) {
     Crash("ExternalIoStatementState::Emit(char) called for input statement");
   }
   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) {
   if constexpr (DIR == Direction::Input) {
     Crash(
         "ExternalIoStatementState::Emit(char16_t) called for input statement");
   }
   // 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>
 bool ExternalIoStatementState<DIR>::Emit(
     const char32_t *data, std::size_t chars) {
   if constexpr (DIR == Direction::Input) {
     Crash(
         "ExternalIoStatementState::Emit(char32_t) called for input statement");
   }
   // 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>
 std::optional<char32_t> ExternalIoStatementState<DIR>::GetCurrentChar() {
   if constexpr (DIR == Direction::Output) {
     Crash(
         "ExternalIoStatementState<Direction::Output>::GetCurrentChar() called");
   }

 }
 
 bool IoStatementState::Emit(
     const char *data, std::size_t n, std::size_t elementBytes) {
   return std::visit(
       [=](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_);
 }
 
 bool IoStatementState::AdvanceRecord(int n) {
   return std::visit([=](auto &x) { return x.get().AdvanceRecord(n); }, u_);
 }
 
 void IoStatementState::BackspaceRecord() {
   std::visit([](auto &x) { x.get().BackspaceRecord(); }, u_);
 }
 
 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_);
 }
 
 ConnectionState &IoStatementState::GetConnectionState() {
   return std::visit(
       [](auto &x) -> ConnectionState & { return x.get().GetConnectionState(); },
       u_);
if (!imaginaryPart_ && ch && *ch == '(') {
     realPart_ = true;
     io.HandleRelativePosition(1);
     edit.descriptor = DataEdit::ListDirectedRealPart;
   }
   return edit;
 }
 
 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(
-        "UnformattedIoStatementState::Receive() called for output statement");
+    this->Crash("ExternalUnformattedIoStatementState::Receive() called for "
+                "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) {
-    this->Crash(
-        "UnformattedIoStatementState::Emit() called for input statement");
-  }
-  return ExternalIoStatementState<DIR>::Emit(data, bytes, elementBytes);
+  return child_.parent().Emit(data, bytes, elementBytes);
+
+template <Direction DIR>
+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>;
 template class InternalIoStatementState<Direction::Input>;
 template class InternalFormattedIoStatementState<Direction::Output>;
 template class InternalFormattedIoStatementState<Direction::Input>;
 template class InternalListIoStatementState<Direction::Output>;
 template class InternalListIoStatementState<Direction::Input>;
 template class ExternalIoStatementState<Direction::Output>;
 template class ExternalIoStatementState<Direction::Input>;
 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 UnformattedIoStatementState<Direction::Input>;
+template class ExternalUnformattedIoStatementState<Direction::Output>;
+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()};
   switch (which_) {
   case Flush:
     ext.Flush(*this);
     std::fflush(nullptr); // flushes C stdio output streams (12.9(2))
     break;

 }
 
 InquireUnitState::InquireUnitState(
     ExternalFileUnit &unit, const char *sourceFile, int sourceLine)
     : ExternalIoStatementBase{unit, sourceFile, sourceLine} {}
 
 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"):
     switch (unit().access) {
     case Access::Sequential:
       str = "SEQUENTIAL";
       break;
     case Access::Direct:
default:
     return false;
   }
 }
 
 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/tools.cpp

if (value) {
     }
   }
   return -1;
 }
 
 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);
   }
 }
 
 void CheckConformability(const Descriptor &to, const Descriptor &x,
     Terminator &terminator, const char *funcName, const char *toName,
     const char *xName) {
   if (x.rank() == 0) {
     return; // scalar conforms with anything

flang/runtime/type-info.h

 #include "descriptor.h"
 #include "flang/Common/Fortran.h"
 #include <cinttypes>
 #include <memory>
 #include <optional>
 
 namespace Fortran::runtime::typeInfo {
 
-class Component;
-
-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
-};
+class DerivedType;
 
 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
 
 struct Binding {
   ProcedurePointer proc;
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
 };
 

 };
 
 struct ProcPtrComponent {
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
   std::uint64_t offset{0};
   ProcedurePointer procInitialization; // for Genre::Procedure
 };
 
-struct SpecialBinding {
+class SpecialBinding {
+public:
   enum class Which : std::uint8_t {
     None = 0,
     Assignment = 4,
     ElementalAssignment = 5,
     Final = 8,
     ElementalFinal = 9,
     AssumedRankFinal = 10,
     ReadFormatted = 16,
     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.
   //   Which::Assignment and Which::ElementalAssignment:
   //     Set to 1, 2, or (usually 3).
   //     The passed-object argument (usually the "to") is always passed via a
   //     a descriptor in the cases where the runtime will call a defined
   //     assignment because these calls are to type-bound generics,
private:
   //     elemental final subroutine must be scalar and monomorphic, but
   //     use a descriptors when the type has LEN parameters.)
   //   Which::AssumedRankFinal: flag must necessarily be set
   //   User derived type I/O:
   //     Set to 1 when "dtv" initial dummy argument is polymorphic, which is
   //     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};
+};
+
+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
 
-  ProcedurePointer proc{nullptr};
+  // 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/type-info.cpp

if (nameDesc.ElementBytes() == compNameLen &&
       return component;
     }
   }
   const DerivedType *ancestor{parent().OffsetElement<DerivedType>()};
   return ancestor ? ancestor->FindDataComponent(compName, compNameLen)
                   : nullptr;
 }
 
+const SpecialBinding *DerivedType::FindSpecialBinding(
+    SpecialBinding::Which which) const {
+  const Descriptor &specialDesc{special()};
+  std::size_t n{specialDesc.Elements()};
+  SubscriptValue at[maxRank];
+  specialDesc.GetLowerBounds(at);
+  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 &&
       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]));
+        static_cast<std::uintmax_t>(uints[j]));
     if (offset == offsetof(DerivedType, binding_)) {
       std::fputs(" <-- binding_\n", f);
     } else if (offset == offsetof(DerivedType, name_)) {
       std::fputs(" <-- name_\n", f);
     } else if (offset == offsetof(DerivedType, sizeInBytes_)) {
       std::fputs(" <-- sizeInBytes_\n", f);
     } else if (offset == offsetof(DerivedType, parent_)) {
       std::fputs(" <-- parent_\n", f);
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);
   }
+  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;
 }
 
 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");
   if (genre_ == Genre::Data) {
     std::fputs("    Data       ", f);
   } else if (genre_ == Genre::Pointer) {
     std::fputs("    Pointer    ", f);
   } else if (genre_ == Genre::Allocatable) {
     std::fputs("    Allocatable", f);
   } else if (genre_ == Genre::Automatic) {
     std::fputs("    Automatic  ", f);
   } else {
     std::fprintf(f, "    (bad genre 0x%x)", static_cast<int>(genre_));
   }
   std::fprintf(f, " category %d  kind %d  rank %d  offset 0x%zx\n", category_,
       kind_, rank_, static_cast<std::size_t>(offset_));
   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/unit-map.cpp

 }
 
 ExternalFileUnit &UnitMap::Create(int n, const Terminator &terminator) {
   Chain &chain{*New<Chain>{terminator}(n).release()};
   chain.next.reset(&chain);
   bucket_[Hash(n)].swap(chain.next); // pushes new node as list head
   return chain.unit;
 }
+
 } // namespace Fortran::runtime::io

flang/runtime/unit.h

 #include <cstdlib>
 #include <cstring>
 #include <optional>
 #include <variant>
 
 namespace Fortran::runtime::io {
 
 class UnitMap;
+class ChildIo;
 
 class ExternalFileUnit : public ConnectionState,
                          public OpenFile,
                          public FileFrame<ExternalFileUnit> {
 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 &);
   static ExternalFileUnit &LookUpOrCreate(
       int unit, const Terminator &, bool &wasExtant);
   static ExternalFileUnit &LookUpOrCreateAnonymous(int unit, Direction,
       std::optional<bool> isUnformatted, const Terminator &);
   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 &);
 
   void OpenUnit(std::optional<OpenStatus>, std::optional<Action>, Position,
       OwningPtr<char> &&path, std::size_t pathLength, Convert,
       IoErrorHandler &);
   void OpenAnonymousUnit(std::optional<OpenStatus>, std::optional<Action>,
       Position, Convert, IoErrorHandler &);
   void CloseUnit(CloseStatus, IoErrorHandler &);
   void DestroyClosed();
 
   bool SetDirection(Direction, IoErrorHandler &);
 
   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>) {
       state.mutableModes() = ConnectionState::modes;
     }
     io_.emplace(state);
     return *io_;
   }
public:
   void Rewind(IoErrorHandler &);
   void EndIoStatement();
   void SetPosition(std::int64_t pos) {
     frameOffsetInFile_ = pos;
     recordOffsetInFrame_ = 0;
     BeginRecord();
   }
 
+  ChildIo *GetChildIo() { return child_.get(); }
+  ChildIo &PushChildIo(IoStatementState &);
+  void PopChildIo(ChildIo &);
+
 private:
   static UnitMap &GetUnitMap();
   const char *FrameNextInput(IoErrorHandler &, std::size_t);
   void BeginSequentialVariableUnformattedInputRecord(IoErrorHandler &);
   void BeginSequentialVariableFormattedInputRecord(IoErrorHandler &);
   void BackspaceFixedRecord(IoErrorHandler &);
   void BackspaceVariableUnformattedRecord(IoErrorHandler &);
   void BackspaceVariableFormattedRecord(IoErrorHandler &);
private:
   Lock lock_;
 
   // When an I/O statement is in progress on this unit, holds its state.
   std::variant<std::monostate, OpenStatementState, CloseStatementState,
       ExternalFormattedIoStatementState<Direction::Output>,
       ExternalFormattedIoStatementState<Direction::Input>,
       ExternalListIoStatementState<Direction::Output>,
       ExternalListIoStatementState<Direction::Input>,
-      UnformattedIoStatementState<Direction::Output>,
-      UnformattedIoStatementState<Direction::Input>, InquireUnitState,
+      ExternalUnformattedIoStatementState<Direction::Output>,
+      ExternalUnformattedIoStatementState<Direction::Input>, InquireUnitState,
       ExternalMiscIoStatementState>
       u_;
 
   // Points to the active alternative (if any) in u_ for use as a Cookie
   std::optional<IoStatementState> io_;
 
   // Subtle: The beginning of the frame can't be allowed to advance
   // during a single list-directed READ due to the possibility of a
   // multi-record CHARACTER value with a "r*" repeat count.  So we
   // manage the frame and the current record therein separately.
   std::int64_t frameOffsetInFile_{0};
   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
 #endif // FORTRAN_RUNTIME_IO_UNIT_H_

flang/runtime/unit.cpp

ExternalFileUnit &ExternalFileUnit::CreateNew(
   RUNTIME_CHECK(terminator, !wasExtant);
   return result;
 }
 
 ExternalFileUnit *ExternalFileUnit::LookUpForClose(int unit) {
   return GetUnitMap().LookUpForClose(unit);
 }
 
-int ExternalFileUnit::NewUnit(const Terminator &terminator) {
-  return GetUnitMap().NewUnit(terminator).unitNumber();
+ExternalFileUnit &ExternalFileUnit::NewUnit(
+    const Terminator &terminator, bool forChildIo) {
+  ExternalFileUnit &unit{GetUnitMap().NewUnit(terminator)};
+  unit.createdForInternalChildIo_ = forChildIo;
+  return unit;
 }
 
 void ExternalFileUnit::OpenUnit(std::optional<OpenStatus> status,
     std::optional<Action> action, Position position, OwningPtr<char> &&newPath,
     std::size_t newPathLength, Convert convert, IoErrorHandler &handler) {
   if (executionEnvironment.conversion != Convert::Unknown) {
     convert = executionEnvironment.conversion;
   }

 }
 
 void ExternalFileUnit::DoEndfile(IoErrorHandler &handler) {
   endfileRecordNumber = currentRecordNumber;
   Truncate(frameOffsetInFile_ + recordOffsetInFrame_, 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/test/Semantics/typeinfo01.f90

subroutine wu(x,u,iostat,iomsg)
     character(len=*), intent(inout) :: iomsg
   end subroutine
 !CHECK: .dt.t, SAVE, TARGET: ObjectEntity type: TYPE(derivedtype) init:derivedtype(binding=.v.t,name=.n.t,sizeinbytes=0_8,parent=NULL(),uninstantiated=NULL(),kindparameter=NULL(),lenparameterkind=NULL(),component=NULL(),procptr=NULL(),special=.s.t)
 !CHECK: .s.t, SAVE, TARGET: ObjectEntity type: TYPE(specialbinding) shape: 0_8:3_8 init:[specialbinding::specialbinding(which=16_1,rank=0_1,isargdescriptorset=1_1,proc=rf),specialbinding(which=17_1,rank=0_1,isargdescriptorset=1_1,proc=ru),specialbinding(which=18_1,rank=0_1,isargdescriptorset=1_1,proc=wf),specialbinding(which=19_1,rank=0_1,isargdescriptorset=1_1,proc=wu)]
 !CHECK: .v.t, SAVE, TARGET: ObjectEntity type: TYPE(binding) shape: 0_8:3_8 init:[binding::binding(proc=rf,name=.n.rf),binding(proc=ru,name=.n.ru),binding(proc=wf,name=.n.wf),binding(proc=wu,name=.n.wu)]
 end module
 
 module m10
-  type :: t
+  type, bind(c) :: t ! non-extensible
   end type
   interface read(formatted)
     procedure :: rf
   end interface
   interface read(unformatted)
     procedure :: ru
   end interface
   interface write(formatted)