[flang][runtime] Refine state associated with child I/O (#150461)

klausler · web-flow · commit 918d6db329b9 · 2025-07-25T14:48:31.000-07:00
Child I/O state needs to carry a pointer to the original non-type-bound defined I/O subroutine table, so that nested defined I/O can call those defined I/O subroutines. It also needs to maintain a mutableModes instance for the whole invocation of defined I/O, instead of having a mutableModes local to list-directed child I/O, so that a top-level data transfer statement with (say) DECIMAL='COMMA' propagates that setting down to nested child I/O data transfers. Fixes #149885.
diff --git a/flang-rt/include/flang-rt/runtime/io-stmt.h b/flang-rt/include/flang-rt/runtime/io-stmt.h
@@ -84,6 +84,9 @@ class IoStatementState {
   // This design avoids virtual member functions and function pointers,
   // which may not have good support in some runtime environments.
 
+  RT_API_ATTRS const NonTbpDefinedIoTable *nonTbpDefinedIoTable() const;
+  RT_API_ATTRS void set_nonTbpDefinedIoTable(const NonTbpDefinedIoTable *);
+
   // CompleteOperation() is the last opportunity to raise an I/O error.
   // It is called by EndIoStatement(), but it can be invoked earlier to
   // catch errors for (e.g.) GetIoMsg() and GetNewUnit().  If called
@@ -363,6 +366,13 @@ class IoStatementBase : public IoErrorHandler {
   using IoErrorHandler::IoErrorHandler;
 
   RT_API_ATTRS bool completedOperation() const { return completedOperation_; }
+  RT_API_ATTRS const NonTbpDefinedIoTable *nonTbpDefinedIoTable() const {
+    return nonTbpDefinedIoTable_;
+  }
+  RT_API_ATTRS void set_nonTbpDefinedIoTable(
+      const NonTbpDefinedIoTable *table) {
+    nonTbpDefinedIoTable_ = table;
+  }
 
   RT_API_ATTRS void CompleteOperation() { completedOperation_ = true; }
   RT_API_ATTRS int EndIoStatement() { return GetIoStat(); }
@@ -397,6 +407,11 @@ class IoStatementBase : public IoErrorHandler {
 
 protected:
   bool completedOperation_{false};
+
+private:
+  // Original NonTbpDefinedIoTable argument to Input/OutputDerivedType,
+  // saved here so that it can also be used in child I/O statements.
+  const NonTbpDefinedIoTable *nonTbpDefinedIoTable_{nullptr};
 };
 
 // Common state for list-directed & NAMELIST I/O, both internal & external
@@ -630,8 +645,10 @@ class ChildIoStatementState : public IoStatementBase,
 public:
   RT_API_ATTRS ChildIoStatementState(
       ChildIo &, const char *sourceFile = nullptr, int sourceLine = 0);
+  RT_API_ATTRS const NonTbpDefinedIoTable *nonTbpDefinedIoTable() const;
+  RT_API_ATTRS void set_nonTbpDefinedIoTable(const NonTbpDefinedIoTable *);
   RT_API_ATTRS ChildIo &child() { return child_; }
-  RT_API_ATTRS MutableModes &mutableModes();
+  RT_API_ATTRS MutableModes &mutableModes() { return mutableModes_; }
   RT_API_ATTRS ConnectionState &GetConnectionState();
   RT_API_ATTRS ExternalFileUnit *GetExternalFileUnit() const;
   RT_API_ATTRS int EndIoStatement();
@@ -644,6 +661,7 @@ class ChildIoStatementState : public IoStatementBase,
 
 private:
   ChildIo &child_;
+  MutableModes mutableModes_;
 };
 
 template <Direction DIR, typename CHAR>
@@ -654,7 +672,6 @@ class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
   RT_API_ATTRS ChildFormattedIoStatementState(ChildIo &, const CharType *format,
       std::size_t formatLength, const Descriptor *formatDescriptor = nullptr,
       const char *sourceFile = nullptr, int sourceLine = 0);
-  RT_API_ATTRS MutableModes &mutableModes() { return mutableModes_; }
   RT_API_ATTRS void CompleteOperation();
   RT_API_ATTRS int EndIoStatement();
   RT_API_ATTRS bool AdvanceRecord(int = 1);
@@ -664,7 +681,6 @@ class ChildFormattedIoStatementState : public ChildIoStatementState<DIR>,
   }
 
 private:
-  MutableModes mutableModes_;
   FormatControl<ChildFormattedIoStatementState> format_;
 };
 
@@ -840,7 +856,7 @@ class InquireUnconnectedFileState : public NoUnitIoStatementState {
 };
 
 class InquireIOLengthState : public NoUnitIoStatementState,
-                             public OutputStatementState {
+                             public IoDirectionState<Direction::Output> {
 public:
   RT_API_ATTRS InquireIOLengthState(
       const char *sourceFile = nullptr, int sourceLine = 0);
diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp
@@ -47,15 +47,19 @@ static RT_API_ATTRS Fortran::common::optional<bool> DefinedFormattedIo(
     const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special,
     const SubscriptValue subscripts[]) {
-  Fortran::common::optional<DataEdit> peek{
-      io.GetNextDataEdit(0 /*to peek at it*/)};
+  // Look at the next data edit descriptor.  If this is list-directed I/O, the
+  // "maxRepeat=0" argument will prevent the input from advancing over an
+  // initial '(' that shouldn't be consumed now as the start of a real part.
+  Fortran::common::optional<DataEdit> peek{io.GetNextDataEdit(/*maxRepeat=*/0)};
   if (peek &&
       (peek->descriptor == DataEdit::DefinedDerivedType ||
-          peek->descriptor == DataEdit::ListDirected)) {
+          peek->descriptor == DataEdit::ListDirected ||
+          peek->descriptor == DataEdit::ListDirectedRealPart)) {
     // Defined formatting
     IoErrorHandler &handler{io.GetIoErrorHandler()};
-    DataEdit edit{*io.GetNextDataEdit(1)}; // now consume it; no repeats
-    RUNTIME_CHECK(handler, edit.descriptor == peek->descriptor);
+    DataEdit edit{peek->descriptor == DataEdit::ListDirectedRealPart
+            ? *peek
+            : *io.GetNextDataEdit(1)};
     char ioType[2 + edit.maxIoTypeChars];
     auto ioTypeLen{std::size_t{2} /*"DT"*/ + edit.ioTypeChars};
     if (edit.descriptor == DataEdit::DefinedDerivedType) {
@@ -836,13 +840,23 @@ template RT_API_ATTRS int DescriptorIoTicket<Direction::Input>::Continue(
 
 template <Direction DIR>
 RT_API_ATTRS bool DescriptorIO(IoStatementState &io,
-    const Descriptor &descriptor, const NonTbpDefinedIoTable *table) {
+    const Descriptor &descriptor, const NonTbpDefinedIoTable *originalTable) {
   bool anyIoTookPlace{false};
+  const NonTbpDefinedIoTable *defaultTable{io.nonTbpDefinedIoTable()};
+  const NonTbpDefinedIoTable *table{originalTable};
+  if (!table) {
+    table = defaultTable;
+  } else if (table != defaultTable) {
+    io.set_nonTbpDefinedIoTable(table); // for nested I/O
+  }
   WorkQueue workQueue{io.GetIoErrorHandler()};
   if (workQueue.BeginDescriptorIo<DIR>(io, descriptor, table, anyIoTookPlace) ==
       StatContinue) {
     workQueue.Run();
   }
+  if (defaultTable != table) {
+    io.set_nonTbpDefinedIoTable(defaultTable);
+  }
   return anyIoTookPlace;
 }
 
diff --git a/flang-rt/lib/runtime/edit-input.cpp b/flang-rt/lib/runtime/edit-input.cpp
@@ -37,9 +37,7 @@ static RT_API_ATTRS bool CheckCompleteListDirectedField(
   if (edit.IsListDirected()) {
     std::size_t byteCount;
     if (auto ch{io.GetCurrentChar(byteCount)}) {
-      if (IsCharValueSeparator(edit, *ch)) {
-        return true;
-      } else {
+      if (!IsCharValueSeparator(edit, *ch)) {
         const auto &connection{io.GetConnectionState()};
         io.GetIoErrorHandler().SignalError(IostatBadListDirectedInputSeparator,
             "invalid character (0x%x) after list-directed input value, "
@@ -49,12 +47,9 @@ static RT_API_ATTRS bool CheckCompleteListDirectedField(
             static_cast<int>(connection.currentRecordNumber));
         return false;
       }
-    } else {
-      return true; // end of record: ok
     }
-  } else {
-    return true;
   }
+  return true;
 }
 
 template <int LOG2_BASE>
@@ -537,9 +532,11 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
       io.SkipSpaces(remaining);
       next = io.NextInField(remaining, edit);
     }
-    if (!next) { // NextInField fails on separators like ')'
+    if (!next || *next == ')') { // NextInField fails on separators like ')'
       std::size_t byteCount{0};
-      next = io.GetCurrentChar(byteCount);
+      if (!next) {
+        next = io.GetCurrentChar(byteCount);
+      }
       if (next && *next == ')') {
         io.HandleRelativePosition(byteCount);
       }
diff --git a/flang-rt/lib/runtime/io-stmt.cpp b/flang-rt/lib/runtime/io-stmt.cpp
@@ -526,6 +526,17 @@ Fortran::common::optional<DataEdit> IoStatementState::GetNextDataEdit(int n) {
       [&](auto &x) { return x.get().GetNextDataEdit(*this, n); }, u_);
 }
 
+const NonTbpDefinedIoTable *IoStatementState::nonTbpDefinedIoTable() const {
+  return common::visit(
+      [&](auto &x) { return x.get().nonTbpDefinedIoTable(); }, u_);
+}
+
+void IoStatementState::set_nonTbpDefinedIoTable(
+    const NonTbpDefinedIoTable *table) {
+  common::visit(
+      [&](auto &x) { return x.get().set_nonTbpDefinedIoTable(table); }, u_);
+}
+
 bool IoStatementState::Emit(
     const char *data, std::size_t bytes, std::size_t elementBytes) {
   return common::visit(
@@ -633,10 +644,10 @@ IoStatementState::FastAsciiField IoStatementState::GetUpcomingFastAsciiField() {
   if (!connection.isUTF8 && connection.internalIoCharKind <= 1) {
     const char *p{nullptr};
     if (std::size_t bytes{GetNextInputBytes(p)}) {
-      return FastAsciiField(connection, p, bytes);
+      return FastAsciiField{connection, p, bytes};
     }
   }
-  return FastAsciiField(connection);
+  return FastAsciiField{connection};
 }
 
 Fortran::common::optional<char32_t> IoStatementState::NextInField(
@@ -920,9 +931,12 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
       fastField.connection().positionInRecord = start;
     }
   }
-  if (!imaginaryPart_ && ch && *ch == '(') {
-    realPart_ = true;
-    fastField.connection().HandleRelativePosition(byteCount);
+  if (!imaginaryPart_ && edit.descriptor == DataEdit::ListDirected && ch &&
+      *ch == '(') {
+    if (maxRepeat > 0) { // not being peeked at fram DefinedFormattedIo()
+      realPart_ = true;
+      fastField.connection().HandleRelativePosition(byteCount);
+    }
     edit.descriptor = DataEdit::ListDirectedRealPart;
   }
   return edit;
@@ -952,12 +966,24 @@ bool ExternalUnformattedIoStatementState<DIR>::Receive(
 template <Direction DIR>
 ChildIoStatementState<DIR>::ChildIoStatementState(
     ChildIo &child, const char *sourceFile, int sourceLine)
-    : IoStatementBase{sourceFile, sourceLine}, child_{child} {}
+    : IoStatementBase{sourceFile, sourceLine}, child_{child},
+      mutableModes_{child.parent().mutableModes()} {}
+
+template <Direction DIR>
+const NonTbpDefinedIoTable *
+ChildIoStatementState<DIR>::nonTbpDefinedIoTable() const {
+#if !defined(RT_DEVICE_AVOID_RECURSION)
+  return child_.parent().nonTbpDefinedIoTable();
+#else
+  ReportUnsupportedChildIo();
+#endif
+}
 
 template <Direction DIR>
-MutableModes &ChildIoStatementState<DIR>::mutableModes() {
+void ChildIoStatementState<DIR>::set_nonTbpDefinedIoTable(
+    const NonTbpDefinedIoTable *table) {
 #if !defined(RT_DEVICE_AVOID_RECURSION)
-  return child_.parent().mutableModes();
+  child_.parent().set_nonTbpDefinedIoTable(table);
 #else
   ReportUnsupportedChildIo();
 #endif
@@ -1030,9 +1056,7 @@ ChildFormattedIoStatementState<DIR, CHAR>::ChildFormattedIoStatementState(
     ChildIo &child, const CHAR *format, std::size_t formatLength,
     const Descriptor *formatDescriptor, const char *sourceFile, int sourceLine)
     : ChildIoStatementState<DIR>{child, sourceFile, sourceLine},
-      mutableModes_{child.parent().mutableModes()}, format_{*this, format,
-                                                        formatLength,
-                                                        formatDescriptor} {}
+      format_{*this, format, formatLength, formatDescriptor} {}
 
 template <Direction DIR, typename CHAR>
 void ChildFormattedIoStatementState<DIR, CHAR>::CompleteOperation() {
