[flang] [llvm] [flang] Extension: allow char string edit descriptors in input formats (PR #140624)

[Peter Klausler via llvm-commits]

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

>From 46cfbd8f14330fab69ba3f4236ca9e7a53e7a35a Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 19 May 2025 14:13:09 -0700
Subject: [PATCH] [flang] Extension: allow char string edit descriptors in
 input formats

FORMAT("J=",I3) is accepted by a few other Fortran compilers as a valid
format for input as well as for output.  The character string edit
descriptor "J=" is interpreted as if it had been 2X on input, causing
two characters to be skipped over.  The skipped characters don't have
to match the characters in the literal string.  An optional warning
is emitted under control of the -pedantic option.
---
 .../flang-rt/runtime/format-implementation.h        | 13 +++++++++++--
 flang-rt/unittests/Runtime/NumericalFormatTest.cpp  |  1 +
 flang/docs/Extensions.md                            |  4 ++++
 flang/include/flang/Common/format.h                 |  8 ++++----
 flang/test/Semantics/io09.f90                       |  6 +++---
 5 files changed, 23 insertions(+), 9 deletions(-)

diff --git a/flang-rt/include/flang-rt/runtime/format-implementation.h b/flang-rt/include/flang-rt/runtime/format-implementation.h
index 8f4eb1161dd14..85dc922bc31bc 100644
--- a/flang-rt/include/flang-rt/runtime/format-implementation.h
+++ b/flang-rt/include/flang-rt/runtime/format-implementation.h
@@ -427,7 +427,11 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
       } else {
         --chars;
       }
-      EmitAscii(context, format_ + start, chars);
+      if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
+        context.HandleRelativePosition(chars);
+      } else {
+        EmitAscii(context, format_ + start, chars);
+      }
     } else if (ch == 'H') {
       // 9HHOLLERITH
       if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
@@ -435,7 +439,12 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
             maybeReversionPoint);
         return 0;
       }
-      EmitAscii(context, format_ + offset_, static_cast<std::size_t>(*repeat));
+      if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
+        context.HandleRelativePosition(static_cast<std::size_t>(*repeat));
+      } else {
+        EmitAscii(
+            context, format_ + offset_, static_cast<std::size_t>(*repeat));
+      }
       offset_ += *repeat;
     } else if (ch >= 'A' && ch <= 'Z') {
       int start{offset_ - 1};
diff --git a/flang-rt/unittests/Runtime/NumericalFormatTest.cpp b/flang-rt/unittests/Runtime/NumericalFormatTest.cpp
index a752f9d6c723b..f1492d0e39fec 100644
--- a/flang-rt/unittests/Runtime/NumericalFormatTest.cpp
+++ b/flang-rt/unittests/Runtime/NumericalFormatTest.cpp
@@ -882,6 +882,7 @@ TEST(IOApiTests, EditDoubleInputValues) {
       {"(F18.1)", "               125", 0x4029000000000000, 0},
       {"(F18.2)", "               125", 0x3ff4000000000000, 0},
       {"(F18.3)", "               125", 0x3fc0000000000000, 0},
+      {"('str',F3.0)", "xxx125", 0x405f400000000000, 0},
       {"(-1P,F18.0)", "               125", 0x4093880000000000, 0}, // 1250
       {"(1P,F18.0)", "               125", 0x4029000000000000, 0}, // 12.5
       {"(BZ,F18.0)", "              125 ", 0x4093880000000000, 0}, // 1250
diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 00a7e2bac84e6..1cc4881438cc1 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -424,6 +424,10 @@ end
 * A zero field width is allowed for logical formatted output (`L0`).
 * `OPEN(..., FORM='BINARY')` is accepted as a legacy synonym for
   the standard `OPEN(..., FORM='UNFORMATTED', ACCESS='STREAM')`.
+* A character string edit descriptor is allowed in an input format
+  with an optional compilation-time warning.  When executed, it
+  is treated as an 'nX' positioning control descriptor that skips
+  over the same number of characters, without comparison.
 
 ### Extensions supported when enabled by options
 
diff --git a/flang/include/flang/Common/format.h b/flang/include/flang/Common/format.h
index da416506ffb5d..1650f56140b4d 100644
--- a/flang/include/flang/Common/format.h
+++ b/flang/include/flang/Common/format.h
@@ -430,11 +430,11 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
       }
     }
     SetLength();
-    if (stmt_ == IoStmtKind::Read &&
-        previousToken_.kind() != TokenKind::DT) { // 13.3.2p6
-      ReportError("String edit descriptor in READ format expression");
-    } else if (token_.kind() != TokenKind::String) {
+    if (token_.kind() != TokenKind::String) {
       ReportError("Unterminated string");
+    } else if (stmt_ == IoStmtKind::Read &&
+        previousToken_.kind() != TokenKind::DT) { // 13.3.2p6
+      ReportWarning("String edit descriptor in READ format expression");
     }
     break;
   default:
diff --git a/flang/test/Semantics/io09.f90 b/flang/test/Semantics/io09.f90
index 495cbf059005c..7fc9d8ffe7b4b 100644
--- a/flang/test/Semantics/io09.f90
+++ b/flang/test/Semantics/io09.f90
@@ -1,8 +1,8 @@
-! RUN: %python %S/test_errors.py %s %flang_fc1
-  !ERROR: String edit descriptor in READ format expression
+! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
+  !WARNING: String edit descriptor in READ format expression
   read(*,'("abc")')
 
-  !ERROR: String edit descriptor in READ format expression
+  !ERROR: Unterminated string
   !ERROR: Unterminated format expression
   read(*,'("abc)')