[flang-commits] [flang] 4c6b60a - [flang] Extension: allow char string edit descriptors in input formats (#140624)

[via flang-commits]

Author: Peter Klausler
Date: 2025-05-28T13:58:22-07:00
New Revision: 4c6b60a639a674f22f5b3aeac0f05ad5aacc552a

URL: https://github.com/llvm/llvm-project/commit/4c6b60a639a674f22f5b3aeac0f05ad5aacc552a
DIFF: https://github.com/llvm/llvm-project/commit/4c6b60a639a674f22f5b3aeac0f05ad5aacc552a.diff

LOG: [flang] Extension: allow char string edit descriptors in input formats (#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.

Added: 
    

Modified: 
    flang-rt/include/flang-rt/runtime/format-implementation.h
    flang-rt/unittests/Runtime/NumericalFormatTest.cpp
    flang/docs/Extensions.md
    flang/include/flang/Common/format.h
    flang/test/Semantics/io09.f90

Removed: 
    


################################################################################
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)')