[flang] [llvm] [flang][runtime] Let more list-directed child input advance (PR #160590)

Peter Klausler via llvm-commits llvm-commits at lists.llvm.org
Thu Sep 25 08:38:14 PDT 2025


https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/160590

>From 33ad7fa4c85998dced0d46b8cce7306614a2fba4 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 24 Sep 2025 12:29:33 -0700
Subject: [PATCH] [flang][runtime] Let more list-directed child input advance

Whether list-directed child READ statements should be allowed
to advance to further records is neither explicit in the standard
nor consistent in existing Fortran implementations.  We allow
child namelist READ statements to advance, but not other list-
directed child input.

This patch refines our interpretation of this case.  Child namelist
READ statements continue to be able to advance; in addition, non-namelist
child READ statements can now advance if their parent READ statement
is a list-directed input statement at the top level, or a child
that could.  But non-namelist list-directed child input taking
place in a context with explicit format control won't advance
to following records, so that the format-controlled parent READ
statement can retain control over record advancement.

Also corrects two cases of record repositioning in numeric input
editing, which were failing under child input because they weren't
allowing for left tab limits.

Fixes https://github.com/llvm/llvm-project/issues/160351.
---
 flang-rt/include/flang-rt/runtime/io-error.h | 11 ++++++
 flang-rt/include/flang-rt/runtime/io-stmt.h  |  7 ++++
 flang-rt/lib/runtime/descriptor-io.cpp       |  6 ++-
 flang-rt/lib/runtime/edit-input.cpp          | 10 +++--
 flang-rt/lib/runtime/io-stmt.cpp             | 39 +++++++++++++-------
 flang/docs/Extensions.md                     | 11 ++++++
 6 files changed, 65 insertions(+), 19 deletions(-)

diff --git a/flang-rt/include/flang-rt/runtime/io-error.h b/flang-rt/include/flang-rt/runtime/io-error.h
index 3e8401036f289..0ac1183131808 100644
--- a/flang-rt/include/flang-rt/runtime/io-error.h
+++ b/flang-rt/include/flang-rt/runtime/io-error.h
@@ -67,6 +67,17 @@ class IoErrorHandler : public Terminator {
   RT_API_ATTRS int GetIoStat() const { return ioStat_; }
   RT_API_ATTRS bool GetIoMsg(char *, std::size_t);
 
+  // Sets the HasEnd flag so that EOF isn't fatal; used to peek ahead
+  RT_API_ATTRS bool SetHasEnd(bool yes = true) {
+    bool oldValue{(flags_ & hasEnd) != 0};
+    if (yes) {
+      flags_ |= hasEnd;
+    } else {
+      flags_ &= ~hasEnd;
+    }
+    return oldValue;
+  }
+
 private:
   enum Flag : std::uint8_t {
     hasIoStat = 1, // IOSTAT=
diff --git a/flang-rt/include/flang-rt/runtime/io-stmt.h b/flang-rt/include/flang-rt/runtime/io-stmt.h
index 1c4f06c0a7082..1cb72d87d3dfa 100644
--- a/flang-rt/include/flang-rt/runtime/io-stmt.h
+++ b/flang-rt/include/flang-rt/runtime/io-stmt.h
@@ -703,6 +703,13 @@ class ChildListIoStatementState : public ChildIoStatementState<DIR>,
   using ListDirectedStatementState<DIR>::GetNextDataEdit;
   RT_API_ATTRS bool AdvanceRecord(int = 1);
   RT_API_ATTRS int EndIoStatement();
+  RT_API_ATTRS bool CanAdvance() {
+    return DIR == Direction::Input &&
+        (canAdvance_ || this->mutableModes().inNamelist);
+  }
+
+private:
+  bool canAdvance_{false};
 };
 
 template <Direction DIR>
diff --git a/flang-rt/lib/runtime/descriptor-io.cpp b/flang-rt/lib/runtime/descriptor-io.cpp
index e00072510aff7..42ac4c0516637 100644
--- a/flang-rt/lib/runtime/descriptor-io.cpp
+++ b/flang-rt/lib/runtime/descriptor-io.cpp
@@ -47,9 +47,11 @@ static RT_API_ATTRS common::optional<bool> DefinedFormattedIo(
     const typeInfo::DerivedType &derived,
     const typeInfo::SpecialBinding &special,
     const SubscriptValue subscripts[]) {
-  // 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
+  // Look at the next data edit descriptor.  If this is list-directed input,
+  // 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.
+  // It also allows reaching EOF without crashing, since the EOF only matters
+  // if a child READ is actually performed.
   common::optional<DataEdit> peek{io.GetNextDataEdit(/*maxRepeat=*/0)};
   if (peek &&
       (peek->descriptor == DataEdit::DefinedDerivedType ||
diff --git a/flang-rt/lib/runtime/edit-input.cpp b/flang-rt/lib/runtime/edit-input.cpp
index 6ab546ee59f74..436fc3894d902 100644
--- a/flang-rt/lib/runtime/edit-input.cpp
+++ b/flang-rt/lib/runtime/edit-input.cpp
@@ -53,11 +53,13 @@ static RT_API_ATTRS bool EditBOZInput(
     IoStatementState &io, const DataEdit &edit, void *n, std::size_t bytes) {
   // Skip leading white space & zeroes
   common::optional<int> remaining{io.CueUpInput(edit)};
-  auto start{io.GetConnectionState().positionInRecord};
+  const ConnectionState &connection{io.GetConnectionState()};
+  auto leftTabLimit{connection.leftTabLimit.value_or(0)};
+  auto start{connection.positionInRecord - leftTabLimit};
   common::optional<char32_t> next{io.NextInField(remaining, edit)};
   if (next.value_or('?') == '0') {
     do {
-      start = io.GetConnectionState().positionInRecord;
+      start = connection.positionInRecord - leftTabLimit;
       next = io.NextInField(remaining, edit);
     } while (next && *next == '0');
   }
@@ -447,7 +449,9 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
     }
     // In list-directed input, a bad exponent is not consumed.
     auto nextBeforeExponent{next};
-    auto startExponent{io.GetConnectionState().positionInRecord};
+    const ConnectionState &connection{io.GetConnectionState()};
+    auto leftTabLimit{connection.leftTabLimit.value_or(0)};
+    auto startExponent{connection.positionInRecord - leftTabLimit};
     bool hasGoodExponent{false};
     if (next) {
       if (isHexadecimal) {
diff --git a/flang-rt/lib/runtime/io-stmt.cpp b/flang-rt/lib/runtime/io-stmt.cpp
index 7bcba5fe71ee4..b958f23cf5342 100644
--- a/flang-rt/lib/runtime/io-stmt.cpp
+++ b/flang-rt/lib/runtime/io-stmt.cpp
@@ -880,6 +880,9 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
     edit.descriptor = DataEdit::ListDirectedImaginaryPart;
   }
   auto fastField{io.GetUpcomingFastAsciiField()};
+  // Reaching EOF is okay when peeking at list-directed defined input;
+  // pretend that there's an END= in that case.
+  bool oldHasEnd{maxRepeat == 0 && !io.GetIoErrorHandler().SetHasEnd()};
   auto ch{io.GetNextNonBlank(byteCount, &fastField)};
   if (ch && *ch == comma && eatComma_) {
     // Consume comma & whitespace after previous item.
@@ -890,19 +893,23 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
     ch = io.GetNextNonBlank(byteCount, &fastField);
   }
   eatComma_ = true;
-  if (!ch) {
-    return common::nullopt;
+  if (maxRepeat == 0 && !oldHasEnd) {
+    io.GetIoErrorHandler().SetHasEnd(false);
   }
-  if (*ch == '/') {
+  if (!ch) { // EOF
+    if (maxRepeat == 0) {
+      return edit; // DataEdit::ListDirected for look-ahead
+    } else {
+      return common::nullopt;
+    }
+  } else if (*ch == '/') {
     hitSlash_ = true;
     edit.descriptor = DataEdit::ListDirectedNullValue;
     return edit;
-  }
-  if (*ch == comma) { // separator: null value
+  } else if (*ch == comma) { // separator: null value
     edit.descriptor = DataEdit::ListDirectedNullValue;
     return edit;
-  }
-  if (imaginaryPart_) { // can't repeat components
+  } else if (imaginaryPart_) { // can't repeat components
     return edit;
   }
   if (*ch >= '0' && *ch <= '9' && fastField.MightBeRepetitionCount()) {
@@ -1103,10 +1110,19 @@ ChildListIoStatementState<DIR>::ChildListIoStatementState(
     : ChildIoStatementState<DIR>{child, sourceFile, sourceLine} {
 #if !defined(RT_DEVICE_AVOID_RECURSION)
   if constexpr (DIR == Direction::Input) {
-    if (auto *listInput{child.parent()
+    if (const auto *listInput{child.parent()
                 .get_if<ListDirectedStatementState<Direction::Input>>()}) {
       this->set_eatComma(listInput->eatComma());
       this->namelistGroup_ = listInput->namelistGroup();
+      if (auto *childListInput{child.parent()
+                  .get_if<ChildListIoStatementState<Direction::Input>>()}) {
+        // Child list input whose parent is child list input: can advance
+        // if the parent can.
+        this->canAdvance_ = childListInput->CanAdvance();
+      } else {
+        // Child list input of top-level list input: can advance.
+        this->canAdvance_ = true;
+      }
     }
   }
 #else
@@ -1117,12 +1133,7 @@ ChildListIoStatementState<DIR>::ChildListIoStatementState(
 template <Direction DIR>
 bool ChildListIoStatementState<DIR>::AdvanceRecord(int n) {
 #if !defined(RT_DEVICE_AVOID_RECURSION)
-  // Allow child NAMELIST input to advance
-  if (DIR == Direction::Input && this->mutableModes().inNamelist) {
-    return this->child().parent().AdvanceRecord(n);
-  } else {
-    return false;
-  }
+  return this->CanAdvance() && this->child().parent().AdvanceRecord(n);
 #else
   this->ReportUnsupportedChildIo();
 #endif
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index c442a9cd6859e..7a2e2a7d2a7aa 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -917,6 +917,17 @@ print *, [(j,j=1,10)]
   and the portable interpretation across the most common Fortran
   compilers.
 
+* `NAMELIST` child input statements are allowed to advance to further
+  input records.
+  Further, advancement is allowed when the parent input statement is
+  a non-child (top level) list-directed input statement, or, recursively,
+  an intermediate child list-directed input statement that can advance.
+  This means that non-`NAMELIST` list-directed child input statements are
+  not allowed to advance when they have an ancestor formatted input statement
+  that is not list-directed and there is no intervening `NAMELIST`.
+  This design allows format-driven input with `DT` editing to retain
+  control over advancement in child input, while otherwise allowing it.
+
 ## De Facto Standard Features
 
 * `EXTENDS_TYPE_OF()` returns `.TRUE.` if both of its arguments have the



More information about the llvm-commits mailing list