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

[Peter Klausler via llvm-commits]

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

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.

>From f431ed3288ad883ba19f82e06bba81d32678eef4 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/docs/Extensions.md                            |  4 ++++
 flang/include/flang/Common/format.h                 |  8 ++++----
 flang/test/Semantics/io09.f90                       |  6 +++---
 4 files changed, 22 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/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)')