[flang][runtime] Iterate over array elements in user-defined derived type I/O

[klausler]

Summary

It was only handling scalars; change to iterate over all array elements.

[clementval]

LGTM

flang/runtime/descriptor-io.h

for (std::size_t k{0}; k < numComponents;
               io, component, descriptor, subscripts, handler)) {
         return false;
       }
     }
   }
   return true;
 }
 
-std::optional<bool> DefinedFormattedIo(
-    IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
+std::optional<bool> DefinedFormattedIo(IoStatementState &, const Descriptor &,
+    const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
 
 template <Direction DIR>
 static bool FormattedDerivedTypeIO(
     IoStatementState &io, const Descriptor &descriptor) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   // Derived type information must be present for formatted I/O.
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   RUNTIME_CHECK(handler, addendum != nullptr);
   const typeInfo::DerivedType *type{addendum->derivedType()};
   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)}) {
+            DefinedFormattedIo(io, descriptor, *type, *special)}) {
       return *wasDefined; // user-defined I/O was applied
     }
   }
   return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
 }
 
-bool DefinedUnformattedIo(
-    IoStatementState &, const Descriptor &, const typeInfo::SpecialBinding &);
+bool DefinedUnformattedIo(IoStatementState &, const Descriptor &,
+    const typeInfo::DerivedType &, const typeInfo::SpecialBinding &);
 
 // Unformatted I/O
 template <Direction DIR>
 static bool UnformattedDescriptorIO(
     IoStatementState &io, const Descriptor &descriptor) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   const DescriptorAddendum *addendum{descriptor.Addendum()};
   if (const typeInfo::DerivedType *
       type{addendum ? addendum->derivedType() : nullptr}) {
     // derived type unformatted I/O
     if (const typeInfo::SpecialBinding *
         special{type->FindSpecialBinding(DIR == Direction::Input
                 ? typeInfo::SpecialBinding::Which::ReadUnformatted
                 : typeInfo::SpecialBinding::Which::WriteUnformatted)}) {
       // User-defined derived type unformatted I/O
-      return DefinedUnformattedIo(io, descriptor, *special);
+      return DefinedUnformattedIo(io, descriptor, *type, *special);
     } else {
       // Default derived type unformatted I/O
       // TODO: If no component at any level has user defined READ or WRITE
       // (as appropriate), the elements are contiguous, and no byte swapping
       // is active, do a block transfer via the code below.
       return DefaultComponentwiseIO<DIR>(io, descriptor, *type);
     }
   } else {

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"
 #include "flang/Common/restorer.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) {
+    const Descriptor &descriptor, const typeInfo::DerivedType &derived,
+    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(1)}; // now consume it; no repeats
     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<1, true> statDesc;
-    Descriptor &vListDesc{statDesc.descriptor()};
+    StaticDescriptor<1, true> vListStatDesc;
+    Descriptor &vListDesc{vListStatDesc.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) {
if (peek &&
     char ioMsg[100];
     std::optional<std::int64_t> startPos;
     if (edit.descriptor == DataEdit::DefinedDerivedType &&
         special.which() == typeInfo::SpecialBinding::Which::ReadFormatted) {
       // DT is an edit descriptor so everything that the child
       // I/O subroutine reads counts towards READ(SIZE=).
       startPos = io.InquirePos();
     }
+    std::size_t numElements{descriptor.Elements()};
+    SubscriptValue subscripts[maxRank];
+    descriptor.GetLowerBounds(subscripts);
     if (special.IsArgDescriptor(0)) {
+      // "dtv" argument is "class(t)", pass a descriptor
       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,
+      StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;
+      Descriptor &elementDesc{elementStatDesc.descriptor()};
+      elementDesc.Establish(
+          derived, nullptr, 0, nullptr, CFI_attribute_pointer);
+      for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
+        elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
+        p(elementDesc, unit, ioType, vListDesc, ioStat, ioMsg, ioTypeLen,
             sizeof ioMsg);
+        if (ioStat != IostatOk) {
+          break;
+        }
+      }
     } else {
+      // "dtv" argument is "type(t)", pass a raw pointer
       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);
+      for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
+        p(descriptor.Element<char>(subscripts), unit, ioType, vListDesc, ioStat,
+            ioMsg, ioTypeLen, sizeof ioMsg);
+        if (ioStat != IostatOk) {
+          break;
+        }
+      }
     }
     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();
     }
     if (startPos) {
       io.GotChar(io.InquirePos() - *startPos);
     }
     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::DerivedType &derived,
     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];
+  std::size_t numElements{descriptor.Elements()};
+  SubscriptValue subscripts[maxRank];
+  descriptor.GetLowerBounds(subscripts);
   if (special.IsArgDescriptor(0)) {
+    // "dtv" argument is "class(t)", pass a descriptor
     auto *p{special.GetProc<void (*)(
         const Descriptor &, int &, int &, char *, std::size_t)>()};
-    p(descriptor, unit, ioStat, ioMsg, sizeof ioMsg);
+    StaticDescriptor<1, true, 10 /*?*/> elementStatDesc;
+    Descriptor &elementDesc{elementStatDesc.descriptor()};
+    elementDesc.Establish(derived, nullptr, 0, nullptr, CFI_attribute_pointer);
+    for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
+      elementDesc.set_base_addr(descriptor.Element<char>(subscripts));
+      p(elementDesc, unit, ioStat, ioMsg, sizeof ioMsg);
+      if (ioStat != IostatOk) {
+        break;
+      }
+    }
   } else {
+    // "dtv" argument is "type(t)", pass a raw pointer
     auto *p{special.GetProc<void (*)(
         const void *, int &, int &, char *, std::size_t)>()};
-    p(descriptor.raw().base_addr, unit, ioStat, ioMsg, sizeof ioMsg);
+    for (; numElements-- > 0; descriptor.IncrementSubscripts(subscripts)) {
+      p(descriptor.Element<char>(subscripts), unit, ioStat, ioMsg,
+          sizeof ioMsg);
+      if (ioStat != IostatOk) {
+        break;
+      }
+    }
   }
   handler.Forward(ioStat, ioMsg, sizeof ioMsg);
   external->PopChildIo(child);
   return handler.GetIoStat() == IostatOk;
 }
 
 } // namespace Fortran::runtime::io::descr