Skip to content

Commit 46cfbd8

Browse files
committed
[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.
1 parent b7e13ab commit 46cfbd8

File tree

5 files changed

+23
-9
lines changed

5 files changed

+23
-9
lines changed

flang-rt/include/flang-rt/runtime/format-implementation.h

Lines changed: 11 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -427,15 +427,24 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
427427
} else {
428428
--chars;
429429
}
430-
EmitAscii(context, format_ + start, chars);
430+
if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
431+
context.HandleRelativePosition(chars);
432+
} else {
433+
EmitAscii(context, format_ + start, chars);
434+
}
431435
} else if (ch == 'H') {
432436
// 9HHOLLERITH
433437
if (!repeat || *repeat < 1 || offset_ + *repeat > formatLength_) {
434438
ReportBadFormat(context, "Invalid width on Hollerith in FORMAT",
435439
maybeReversionPoint);
436440
return 0;
437441
}
438-
EmitAscii(context, format_ + offset_, static_cast<std::size_t>(*repeat));
442+
if constexpr (std::is_base_of_v<InputStatementState, CONTEXT>) {
443+
context.HandleRelativePosition(static_cast<std::size_t>(*repeat));
444+
} else {
445+
EmitAscii(
446+
context, format_ + offset_, static_cast<std::size_t>(*repeat));
447+
}
439448
offset_ += *repeat;
440449
} else if (ch >= 'A' && ch <= 'Z') {
441450
int start{offset_ - 1};

flang-rt/unittests/Runtime/NumericalFormatTest.cpp

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -882,6 +882,7 @@ TEST(IOApiTests, EditDoubleInputValues) {
882882
{"(F18.1)", " 125", 0x4029000000000000, 0},
883883
{"(F18.2)", " 125", 0x3ff4000000000000, 0},
884884
{"(F18.3)", " 125", 0x3fc0000000000000, 0},
885+
{"('str',F3.0)", "xxx125", 0x405f400000000000, 0},
885886
{"(-1P,F18.0)", " 125", 0x4093880000000000, 0}, // 1250
886887
{"(1P,F18.0)", " 125", 0x4029000000000000, 0}, // 12.5
887888
{"(BZ,F18.0)", " 125 ", 0x4093880000000000, 0}, // 1250

flang/docs/Extensions.md

Lines changed: 4 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -424,6 +424,10 @@ end
424424
* A zero field width is allowed for logical formatted output (`L0`).
425425
* `OPEN(..., FORM='BINARY')` is accepted as a legacy synonym for
426426
the standard `OPEN(..., FORM='UNFORMATTED', ACCESS='STREAM')`.
427+
* A character string edit descriptor is allowed in an input format
428+
with an optional compilation-time warning. When executed, it
429+
is treated as an 'nX' positioning control descriptor that skips
430+
over the same number of characters, without comparison.
427431

428432
### Extensions supported when enabled by options
429433

flang/include/flang/Common/format.h

Lines changed: 4 additions & 4 deletions
Original file line numberDiff line numberDiff line change
@@ -430,11 +430,11 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
430430
}
431431
}
432432
SetLength();
433-
if (stmt_ == IoStmtKind::Read &&
434-
previousToken_.kind() != TokenKind::DT) { // 13.3.2p6
435-
ReportError("String edit descriptor in READ format expression");
436-
} else if (token_.kind() != TokenKind::String) {
433+
if (token_.kind() != TokenKind::String) {
437434
ReportError("Unterminated string");
435+
} else if (stmt_ == IoStmtKind::Read &&
436+
previousToken_.kind() != TokenKind::DT) { // 13.3.2p6
437+
ReportWarning("String edit descriptor in READ format expression");
438438
}
439439
break;
440440
default:

flang/test/Semantics/io09.f90

Lines changed: 3 additions & 3 deletions
Original file line numberDiff line numberDiff line change
@@ -1,8 +1,8 @@
1-
! RUN: %python %S/test_errors.py %s %flang_fc1
2-
!ERROR: String edit descriptor in READ format expression
1+
! RUN: %python %S/test_errors.py %s %flang_fc1 -pedantic
2+
!WARNING: String edit descriptor in READ format expression
33
read(*,'("abc")')
44

5-
!ERROR: String edit descriptor in READ format expression
5+
!ERROR: Unterminated string
66
!ERROR: Unterminated format expression
77
read(*,'("abc)')
88

0 commit comments

Comments
 (0)