[Flang] Fix wrong compile-time error message, issue #178494.#183878
[Flang] Fix wrong compile-time error message, issue #178494.#183878eugeneepshteyn merged 4 commits intollvm:mainfrom
Conversation
|
Thank you for submitting a Pull Request (PR) to the LLVM Project! This PR will be automatically labeled and the relevant teams will be notified. If you wish to, you can add reviewers by using the "Reviewers" section on this page. If this is not working for you, it is probably because you do not have write permissions for the repository. In which case you can instead tag reviewers by name in a comment by using If you have received no comments on your PR for a week, you can request a review by "ping"ing the PR by adding a comment “Ping”. The common courtesy "ping" rate is once a week. Please remember that you are asking for valuable time from other developers. If you have further questions, they may be answered by the LLVM GitHub User Guide. You can also ask questions in a comment on this PR, on the LLVM Discord or on the forums. |
|
@llvm/pr-subscribers-flang-parser Author: None (laoshd) ChangesFix the problem described in issue #178494. It will cover the failures with S, SP, SS, BN, BZ, LZ, LZP, LZS, etc. It will resolve the test failures in PR #183500. Full diff: https://github.com/llvm/llvm-project/pull/183878.diff 10 Files Affected:
diff --git a/flang-rt/include/flang-rt/runtime/format-implementation.h b/flang-rt/include/flang-rt/runtime/format-implementation.h
index d510adbb5ba46..8b341def2b3ce 100644
--- a/flang-rt/include/flang-rt/runtime/format-implementation.h
+++ b/flang-rt/include/flang-rt/runtime/format-implementation.h
@@ -193,7 +193,7 @@ static RT_API_ATTRS bool AbsoluteTabbing(CONTEXT &context, int n) {
template <typename CONTEXT>
static RT_API_ATTRS void HandleControl(
- CONTEXT &context, char ch, char next, int n) {
+ CONTEXT &context, char ch, char next, int n, char next2 = '\0') {
MutableModes &modes{context.mutableModes()};
switch (ch) {
case 'B':
@@ -251,6 +251,21 @@ static RT_API_ATTRS void HandleControl(
return;
}
break;
+ case 'L':
+ if (next == 'Z') {
+ if (next2 == 'S') {
+ // LZS - suppress leading zeros
+ modes.leadingZero = MutableModes::LeadingZeroMode::Suppress;
+ } else if (next2 == 'P') {
+ // LZP - print leading zero
+ modes.leadingZero = MutableModes::LeadingZeroMode::Print;
+ } else {
+ // LZ - processor-dependent (default behavior)
+ modes.leadingZero = MutableModes::LeadingZeroMode::Processor;
+ }
+ return;
+ }
+ break;
case 'S':
if (next == 'P') {
modes.editingFlags |= signPlus;
@@ -455,6 +470,7 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
} else if (ch >= 'A' && ch <= 'Z') {
int start{offset_ - 1};
CharType next{'\0'};
+ CharType next2{'\0'};
if (ch != 'P') { // 1PE5.2 - comma not required (C1302)
CharType peek{Capitalize(PeekNext())};
if (peek >= 'A' && peek <= 'Z') {
@@ -464,6 +480,15 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
// Assume a two-letter edit descriptor
next = peek;
++offset_;
+ } else if (ch == 'L' && peek == 'Z') {
+ // LZ, LZS, or LZP control edit descriptor
+ next = peek;
+ ++offset_;
+ CharType peek2{Capitalize(PeekNext())};
+ if (peek2 == 'S' || peek2 == 'P') {
+ next2 = peek2;
+ ++offset_;
+ }
} else {
// extension: assume a comma between 'ch' and 'peek'
}
@@ -484,7 +509,7 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
repeat = GetIntField(context);
}
HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
- repeat ? *repeat : 1);
+ repeat ? *repeat : 1, static_cast<char>(next2));
}
} else if (ch == '/') {
context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
diff --git a/flang-rt/include/flang-rt/runtime/format.h b/flang-rt/include/flang-rt/runtime/format.h
index 79a7dd713b1a1..787772935ce8c 100644
--- a/flang-rt/include/flang-rt/runtime/format.h
+++ b/flang-rt/include/flang-rt/runtime/format.h
@@ -44,6 +44,12 @@ struct MutableModes {
return editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
}
+ enum class LeadingZeroMode : std::uint8_t {
+ Processor, // LZ: processor-dependent (default)
+ Suppress, // LZS: suppress optional leading zero
+ Print, // LZP: print optional leading zero
+ };
+
std::uint8_t editingFlags{0}; // BN, DP, SS
enum decimal::FortranRounding round{
executionEnvironment
@@ -53,6 +59,7 @@ struct MutableModes {
short scale{0}; // kP
bool inNamelist{false}; // skip ! comments
bool nonAdvancing{false}; // ADVANCE='NO', or $ or \ in FORMAT
+ LeadingZeroMode leadingZero{LeadingZeroMode::Processor}; // LZ/LZS/LZP
};
// A single edit descriptor extracted from a FORMAT
diff --git a/flang-rt/lib/runtime/edit-output.cpp b/flang-rt/lib/runtime/edit-output.cpp
index 73dba35ff08d9..d0aa8638102a9 100644
--- a/flang-rt/lib/runtime/edit-output.cpp
+++ b/flang-rt/lib/runtime/edit-output.cpp
@@ -411,10 +411,26 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
if (totalLength > width || !exponent) {
return EmitRepeated(io_, '*', width);
}
- if (totalLength < width && digitsBeforePoint == 0 &&
- zeroesBeforePoint == 0) {
- zeroesBeforePoint = 1;
- ++totalLength;
+ if (digitsBeforePoint == 0 && zeroesBeforePoint == 0 && scale <= 0) {
+ // Optional leading zero position (F202X leading zero control).
+ // When scale > 0 (kP with k > 0), digits are moved before the decimal
+ // point, so the leading zero position is not optional -- skip this.
+ // Value has no digits before the decimal point: "0.xxxE+yy" vs ".xxxE+yy"
+ switch (edit.modes.leadingZero) {
+ case MutableModes::LeadingZeroMode::Print:
+ // LZP: always print the optional leading zero
+ zeroesBeforePoint = 1;
+ ++totalLength;
+ break;
+ case MutableModes::LeadingZeroMode::Suppress:
+ // LZS: never print the optional leading zero
+ break;
+ case MutableModes::LeadingZeroMode::Processor:
+ // LZ: processor-defined; flang chooses to print it
+ zeroesBeforePoint = 1;
+ ++totalLength;
+ break;
+ }
}
if (totalLength < width && editWidth == 0) {
width = totalLength;
@@ -544,7 +560,24 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
digitsAfterPoint + trailingZeroes ==
0) {
- zeroesBeforePoint = 1; // "." -> "0."
+ zeroesBeforePoint = 1; // "."--> "0." (bare decimal point)
+ } else if (digitsBeforePoint == 0 && zeroesBeforePoint == 0 &&
+ expo <= 0) {
+ // Optional leading zero position (F202X leading zero control).
+ // Value magnitude < 1: "0.xxx" vs ".xxx"
+ switch (edit.modes.leadingZero) {
+ case MutableModes::LeadingZeroMode::Print:
+ // LZP: always print the optional leading zero
+ zeroesBeforePoint = 1;
+ break;
+ case MutableModes::LeadingZeroMode::Suppress:
+ // LZS: never print the optional leading zero
+ break;
+ case MutableModes::LeadingZeroMode::Processor:
+ // LZ: processor-defined; flang chooses to print it
+ zeroesBeforePoint = 1;
+ break;
+ }
}
int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
@@ -553,10 +586,6 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (totalLength > width) {
return EmitRepeated(io_, '*', width);
}
- if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
- zeroesBeforePoint = 1;
- ++totalLength;
- }
return EmitPrefix(edit, totalLength, width) &&
EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
EmitRepeated(io_, '0', zeroesBeforePoint) &&
diff --git a/flang/docs/F202X.md b/flang/docs/F202X.md
index d1940a1858db1..6a303981cf264 100644
--- a/flang/docs/F202X.md
+++ b/flang/docs/F202X.md
@@ -261,6 +261,15 @@ The `AT` edit descriptor automatically trims character output. The `LZP`,
`LZS`, and `LZ` control edit descriptors and `LEADING_ZERO=` specifier provide a
means for controlling the output of leading zero digits.
+Implementation status:
+- `LZ`, `LZS`, `LZP` control edit descriptors, affect only F, E, D, and G
+ editing of an output statement: Implemented
+ - `LZ` - Processor-dependent, default (e.g., `0.2`)
+ - `LZS` - Suppress leading zeros (e.g., `.2`)
+ - `LZP` - Print leading zero (e.g. `0.2`)
+- `AT` edit descriptor: Not yet implemented
+- `LEADING_ZERO=specifier` in OPEN statement: Not yet implemented
+
#### Intrinsic Module Extensions
Addressing some issues and omissions in intrinsic modules:
diff --git a/flang/docs/FortranStandardsSupport.md b/flang/docs/FortranStandardsSupport.md
index f57956cd6d6b8..02e4653280f12 100644
--- a/flang/docs/FortranStandardsSupport.md
+++ b/flang/docs/FortranStandardsSupport.md
@@ -48,7 +48,7 @@ status of all important Fortran 2023 features. The table entries are based on th
| Extensions for c_f_pointer intrinsic | Y | |
| Procedures for converting between fortran and c strings | N | |
| The at edit descriptor | N | |
-| Control over leading zeros in output of real values | N | |
+| Control over leading zeros in output of real values | P | LZ/LZS/LZP edit descriptors implemented; LEADING_ZERO=specifier not yet implemented |
| Extensions for Namelist | N | |
| Allow an object of a type with a coarray ultimate component to be an array or allocatable | N | |
| Put with Notify | N | |
diff --git a/flang/include/flang/Common/format.h b/flang/include/flang/Common/format.h
index 1e64acb823616..60bcc8e81ee38 100644
--- a/flang/include/flang/Common/format.h
+++ b/flang/include/flang/Common/format.h
@@ -114,7 +114,7 @@ struct FormatMessage {
// This declaration is logically private to class FormatValidator.
// It is placed here to work around a clang compilation problem.
ENUM_CLASS(TokenKind, None, A, B, BN, BZ, D, DC, DP, DT, E, EN, ES, EX, F, G, I,
- L, O, P, RC, RD, RN, RP, RU, RZ, S, SP, SS, T, TL, TR, X, Z, Colon, Slash,
+ L, LZ, LZP, LZS, O, P, RC, RD, RN, RP, RU, RZ, S, SP, SS, T, TL, TR, X, Z, Colon, Slash,
Backslash, // nonstandard: inhibit newline on output
Dollar, // nonstandard: inhibit newline on output on terminals
Star, LParen, RParen, Comma, Point, Sign,
@@ -219,7 +219,7 @@ template <typename CHAR = char> class FormatValidator {
std::int64_t knrValue_{-1}; // -1 ==> not present
std::int64_t scaleFactorValue_{}; // signed k in kP
std::int64_t wValue_{-1};
- char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name
+ char argString_[4]{}; // 1-3 character msg arg; usually edit descriptor name
bool formatHasErrors_{false};
bool unterminatedFormatError_{false};
bool suppressMessageCascade_{false};
@@ -390,7 +390,25 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
token_.set_kind(TokenKind::I);
break;
case 'L':
- token_.set_kind(TokenKind::L);
+ switch (LookAheadChar()) {
+ case 'Z':
+ // Advance past 'Z', then look ahead for 'S' or 'P'
+ Advance(TokenKind::LZ);
+ switch (LookAheadChar()) {
+ case 'S':
+ Advance(TokenKind::LZS);
+ break;
+ case 'P':
+ Advance(TokenKind::LZP);
+ break;
+ default:
+ break;
+ }
+ break;
+ default:
+ token_.set_kind(TokenKind::L);
+ break;
+ }
break;
case 'O':
token_.set_kind(TokenKind::O);
@@ -674,9 +692,22 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
ReportError("Unexpected '%s' in format expression", signToken);
}
// Default message argument.
- // Alphabetic edit descriptor names are one or two characters in length.
+ // Alphabetic edit descriptor names are one to three characters in length.
argString_[0] = toupper(format_[token_.offset()]);
- argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0;
+ if (token_.length() > 2) {
+ // Three-character descriptor names (e.g., LZP, LZS).
+ // token_.offset() has the first character and *cursor_ has the last;
+ // find the middle character by scanning past any blanks.
+ const CHAR *mid{format_ + token_.offset() + 1};
+ while (mid < cursor_ && IsWhite(*mid)) {
+ ++mid;
+ }
+ argString_[1] = toupper(*mid);
+ argString_[2] = toupper(*cursor_);
+ } else {
+ argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0;
+ argString_[2] = 0;
+ }
// Process one format edit descriptor or do format list management.
switch (token_.kind()) {
case TokenKind::A:
@@ -794,6 +825,9 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
case TokenKind::BZ:
case TokenKind::DC:
case TokenKind::DP:
+ case TokenKind::LZ:
+ case TokenKind::LZS:
+ case TokenKind::LZP:
case TokenKind::RC:
case TokenKind::RD:
case TokenKind::RN:
@@ -807,6 +841,7 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
// R1318 blank-interp-edit-desc -> BN | BZ
// R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP
// R1320 decimal-edit-desc -> DC | DP
+ // F202X leading-zero-edit-desc -> LZ | LZS | LZP
check_r(false);
NextToken();
break;
diff --git a/flang/include/flang/Parser/format-specification.h b/flang/include/flang/Parser/format-specification.h
index 28c8affd7bde0..5d37a9c2c0060 100644
--- a/flang/include/flang/Parser/format-specification.h
+++ b/flang/include/flang/Parser/format-specification.h
@@ -95,6 +95,9 @@ struct ControlEditDesc {
RP,
DC,
DP,
+ LZ, // F202X: processor-dependent leading zero, default
+ LZS, // F202X: suppress leading zeros
+ LZP, // F202X: print leading zero
Dollar, // extension: inhibit newline on output
Backslash, // ditto, but only on terminals
};
diff --git a/flang/lib/Parser/io-parsers.cpp b/flang/lib/Parser/io-parsers.cpp
index cb3e68a05c94d..6bdf6faca8915 100644
--- a/flang/lib/Parser/io-parsers.cpp
+++ b/flang/lib/Parser/io-parsers.cpp
@@ -552,6 +552,11 @@ TYPE_PARSER(construct<format::FormatItem>(
construct<format::FormatItem>(
maybe(repeat), Parser<format::DerivedTypeDataEditDesc>{}) ||
construct<format::FormatItem>(Parser<format::ControlEditDesc>{}) ||
+ // Error recovery: accept [r] before control-edit-desc so that the
+ // format validator can diagnose a repeat specifier before descriptors
+ // like SS, SP, S, BN, BZ, etc., rather than failing the parse entirely.
+ construct<format::FormatItem>(
+ maybe(repeat), Parser<format::ControlEditDesc>{}) ||
construct<format::FormatItem>(charStringEditDesc) ||
construct<format::FormatItem>(maybe(repeat), parenthesized(formatItems)))
@@ -629,7 +634,8 @@ TYPE_PARSER(construct<format::IntrinsicTypeDataEditDesc>(
"X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) ||
pure(format::IntrinsicTypeDataEditDesc::Kind::E)) ||
"G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) ||
- "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L),
+ ("L "_tok / !letter /* don't occlude LZ, LZS, & LZP */) >>
+ pure(format::IntrinsicTypeDataEditDesc::Kind::L),
noInt, noInt, noInt)))
// R1307 data-edit-desc (part 2 of 2)
@@ -677,6 +683,12 @@ TYPE_PARSER(construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::BN)) ||
"Z " >> construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::BZ))) ||
+ "L " >> ("Z " >> ("S " >> construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZS)) ||
+ "P " >> construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZP)) ||
+ construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZ)))) ||
"R " >> ("U " >> construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::RU)) ||
"D " >> construct<format::ControlEditDesc>(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 3d8ea9f703b2f..8ad1f9b8ff618 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1549,6 +1549,9 @@ class UnparseVisitor {
FMT(RP);
FMT(DC);
FMT(DP);
+ FMT(LZ);
+ FMT(LZS);
+ FMT(LZP);
#undef FMT
case format::ControlEditDesc::Kind::Dollar:
Put('$');
diff --git a/flang/test/Semantics/io16.f90 b/flang/test/Semantics/io16.f90
new file mode 100644
index 0000000000000..559d98f0d5ceb
--- /dev/null
+++ b/flang/test/Semantics/io16.f90
@@ -0,0 +1,99 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+! F202X leading-zero control edit descriptors: LZ, LZS, LZP
+
+ ! Valid uses of LZ, LZP, LZS in FORMAT statements
+1001 format(LZ, F10.3)
+1002 format(LZP, F10.3)
+1003 format(LZS, F10.3)
+1004 format(LZ, E10.3)
+1005 format(LZP, E10.3)
+1006 format(LZS, E10.3)
+1007 format(LZS, D10.3)
+1008 format(LZ, G10.3)
+
+ ! Valid uses with blanks inside keywords (Fortran ignores blanks)
+1009 format(L Z, F10.3)
+1010 format(L Z P, F10.3)
+1011 format(L Z S, F10.3)
+
+ ! Combining with other control edit descriptors
+1012 format(LZP, DC, F10.3)
+1013 format(BN, LZS, F10.3)
+1014 format(LZ, SS, RZ, F10.3)
+
+ ! Multiple groups
+1015 format(LZP, 3F10.3, LZS, 2E12.4)
+
+ ! C1302 : multiple edit descriptors without ',' separation; no errors
+1016 format(LZF10.3)
+1017 format(LZPF10.3)
+1018 format(LZSF10.3)
+1019 format(LZE10.3)
+1020 format(LZPE10.3)
+1021 format(LZSD10.3)
+1022 format(LZG10.3)
+1023 format(LZPDCF10.3)
+1024 format(BNLZSF10.3)
+1025 format(LZPF10.3LZSF10.3)
+1026 format(LZP3F10.3LZS2E12.4)
+
+ ! In WRITE format strings
+ write(*, '(LZ, F10.3)') 0.5
+ write(*, '(LZP, F10.3)') 0.5
+ write(*, '(LZS, F10.3)') 0.5
+ write(*, '(LZP,E10.3)') 0.5
+ write(*, '(LZS,D10.3)') 0.5
+
+ ! C1302 : WRITE format strings without ',' separation; no errors
+ write(*, '(LZF10.3)') 0.5
+ write(*, '(LZPF10.3)') 0.5
+ write(*, '(LZSF10.3)') 0.5
+ write(*, '(LZPE10.3)') 0.5
+ write(*, '(LZP3F10.3LZS2E12.4)') 0.5, 0.5, 0.5, 0.5, 0.5
+
+ ! FMT= specifier with comma-separated descriptors
+ write(*, fmt='(LZ, F10.3)') 0.5
+ write(*, fmt='(LZP, F10.3)') 0.5
+ write(*, fmt='(LZS, F10.3)') 0.5
+ write(*, fmt='(LZP, E10.3)') 0.5
+ write(*, fmt='(LZS, D10.3)') 0.5
+ write(*, fmt='(LZP, DC, F10.3)') 0.5
+ write(*, fmt='(BN, LZS, F10.3)') 0.5
+
+ ! FMT= specifier without ',' separation; no errors
+ write(*, fmt='(LZF10.3)') 0.5
+ write(*, fmt='(LZPF10.3)') 0.5
+ write(*, fmt='(LZSF10.3)') 0.5
+ write(*, fmt='(LZPE10.3)') 0.5
+ write(*, fmt='(LZP3F10.3LZS2E12.4)') 0.5, 0.5, 0.5, 0.5, 0.5
+
+ ! FMT= specifier with FORMAT label reference
+ write(*, fmt=1001) 0.5
+ write(*, fmt=1002) 0.5
+ write(*, fmt=1017) 0.5
+
+ ! LZ/LZP/LZS coexisting with abbreviated L (no width) data edit descriptor
+ write(*, '(LZP, F10.3, L)') 0.5, .true.
+ write(*, '(LZS, F10.3, L)') 0.5, .true.
+
+ ! Error: repeat specifier before LZ/LZP/LZS in WRITE format strings
+ !ERROR: Repeat specifier before 'LZ' edit descriptor
+ write(*, '(3LZ, F10.3)') 0.5
+
+ !ERROR: Repeat specifier before 'LZP' edit descriptor
+ write(*, '(2LZP, F10.3)') 0.5
+
+ !ERROR: Repeat specifier before 'LZS' edit descriptor
+ write(*, '(2LZS, F10.3)') 0.5
+
+ ! Error: repeat specifier before LZ/LZP/LZS in FORMAT statements
+ !ERROR: Repeat specifier before 'LZ' edit descriptor
+2001 format(3LZ, F10.3)
+
+ !ERROR: Repeat specifier before 'LZP' edit descriptor
+2002 format(2LZP, F10.3)
+
+ !ERROR: Repeat specifier before 'LZS' edit descriptor
+2003 format(2LZS, F10.3)
+end
|
|
@llvm/pr-subscribers-flang-semantics Author: None (laoshd) ChangesFix the problem described in issue #178494. It will cover the failures with S, SP, SS, BN, BZ, LZ, LZP, LZS, etc. It will resolve the test failures in PR #183500. Full diff: https://github.com/llvm/llvm-project/pull/183878.diff 10 Files Affected:
diff --git a/flang-rt/include/flang-rt/runtime/format-implementation.h b/flang-rt/include/flang-rt/runtime/format-implementation.h
index d510adbb5ba46..8b341def2b3ce 100644
--- a/flang-rt/include/flang-rt/runtime/format-implementation.h
+++ b/flang-rt/include/flang-rt/runtime/format-implementation.h
@@ -193,7 +193,7 @@ static RT_API_ATTRS bool AbsoluteTabbing(CONTEXT &context, int n) {
template <typename CONTEXT>
static RT_API_ATTRS void HandleControl(
- CONTEXT &context, char ch, char next, int n) {
+ CONTEXT &context, char ch, char next, int n, char next2 = '\0') {
MutableModes &modes{context.mutableModes()};
switch (ch) {
case 'B':
@@ -251,6 +251,21 @@ static RT_API_ATTRS void HandleControl(
return;
}
break;
+ case 'L':
+ if (next == 'Z') {
+ if (next2 == 'S') {
+ // LZS - suppress leading zeros
+ modes.leadingZero = MutableModes::LeadingZeroMode::Suppress;
+ } else if (next2 == 'P') {
+ // LZP - print leading zero
+ modes.leadingZero = MutableModes::LeadingZeroMode::Print;
+ } else {
+ // LZ - processor-dependent (default behavior)
+ modes.leadingZero = MutableModes::LeadingZeroMode::Processor;
+ }
+ return;
+ }
+ break;
case 'S':
if (next == 'P') {
modes.editingFlags |= signPlus;
@@ -455,6 +470,7 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
} else if (ch >= 'A' && ch <= 'Z') {
int start{offset_ - 1};
CharType next{'\0'};
+ CharType next2{'\0'};
if (ch != 'P') { // 1PE5.2 - comma not required (C1302)
CharType peek{Capitalize(PeekNext())};
if (peek >= 'A' && peek <= 'Z') {
@@ -464,6 +480,15 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
// Assume a two-letter edit descriptor
next = peek;
++offset_;
+ } else if (ch == 'L' && peek == 'Z') {
+ // LZ, LZS, or LZP control edit descriptor
+ next = peek;
+ ++offset_;
+ CharType peek2{Capitalize(PeekNext())};
+ if (peek2 == 'S' || peek2 == 'P') {
+ next2 = peek2;
+ ++offset_;
+ }
} else {
// extension: assume a comma between 'ch' and 'peek'
}
@@ -484,7 +509,7 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
repeat = GetIntField(context);
}
HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
- repeat ? *repeat : 1);
+ repeat ? *repeat : 1, static_cast<char>(next2));
}
} else if (ch == '/') {
context.AdvanceRecord(repeat && *repeat > 0 ? *repeat : 1);
diff --git a/flang-rt/include/flang-rt/runtime/format.h b/flang-rt/include/flang-rt/runtime/format.h
index 79a7dd713b1a1..787772935ce8c 100644
--- a/flang-rt/include/flang-rt/runtime/format.h
+++ b/flang-rt/include/flang-rt/runtime/format.h
@@ -44,6 +44,12 @@ struct MutableModes {
return editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
}
+ enum class LeadingZeroMode : std::uint8_t {
+ Processor, // LZ: processor-dependent (default)
+ Suppress, // LZS: suppress optional leading zero
+ Print, // LZP: print optional leading zero
+ };
+
std::uint8_t editingFlags{0}; // BN, DP, SS
enum decimal::FortranRounding round{
executionEnvironment
@@ -53,6 +59,7 @@ struct MutableModes {
short scale{0}; // kP
bool inNamelist{false}; // skip ! comments
bool nonAdvancing{false}; // ADVANCE='NO', or $ or \ in FORMAT
+ LeadingZeroMode leadingZero{LeadingZeroMode::Processor}; // LZ/LZS/LZP
};
// A single edit descriptor extracted from a FORMAT
diff --git a/flang-rt/lib/runtime/edit-output.cpp b/flang-rt/lib/runtime/edit-output.cpp
index 73dba35ff08d9..d0aa8638102a9 100644
--- a/flang-rt/lib/runtime/edit-output.cpp
+++ b/flang-rt/lib/runtime/edit-output.cpp
@@ -411,10 +411,26 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
if (totalLength > width || !exponent) {
return EmitRepeated(io_, '*', width);
}
- if (totalLength < width && digitsBeforePoint == 0 &&
- zeroesBeforePoint == 0) {
- zeroesBeforePoint = 1;
- ++totalLength;
+ if (digitsBeforePoint == 0 && zeroesBeforePoint == 0 && scale <= 0) {
+ // Optional leading zero position (F202X leading zero control).
+ // When scale > 0 (kP with k > 0), digits are moved before the decimal
+ // point, so the leading zero position is not optional -- skip this.
+ // Value has no digits before the decimal point: "0.xxxE+yy" vs ".xxxE+yy"
+ switch (edit.modes.leadingZero) {
+ case MutableModes::LeadingZeroMode::Print:
+ // LZP: always print the optional leading zero
+ zeroesBeforePoint = 1;
+ ++totalLength;
+ break;
+ case MutableModes::LeadingZeroMode::Suppress:
+ // LZS: never print the optional leading zero
+ break;
+ case MutableModes::LeadingZeroMode::Processor:
+ // LZ: processor-defined; flang chooses to print it
+ zeroesBeforePoint = 1;
+ ++totalLength;
+ break;
+ }
}
if (totalLength < width && editWidth == 0) {
width = totalLength;
@@ -544,7 +560,24 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
digitsAfterPoint + trailingZeroes ==
0) {
- zeroesBeforePoint = 1; // "." -> "0."
+ zeroesBeforePoint = 1; // "."--> "0." (bare decimal point)
+ } else if (digitsBeforePoint == 0 && zeroesBeforePoint == 0 &&
+ expo <= 0) {
+ // Optional leading zero position (F202X leading zero control).
+ // Value magnitude < 1: "0.xxx" vs ".xxx"
+ switch (edit.modes.leadingZero) {
+ case MutableModes::LeadingZeroMode::Print:
+ // LZP: always print the optional leading zero
+ zeroesBeforePoint = 1;
+ break;
+ case MutableModes::LeadingZeroMode::Suppress:
+ // LZS: never print the optional leading zero
+ break;
+ case MutableModes::LeadingZeroMode::Processor:
+ // LZ: processor-defined; flang chooses to print it
+ zeroesBeforePoint = 1;
+ break;
+ }
}
int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
@@ -553,10 +586,6 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (totalLength > width) {
return EmitRepeated(io_, '*', width);
}
- if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
- zeroesBeforePoint = 1;
- ++totalLength;
- }
return EmitPrefix(edit, totalLength, width) &&
EmitAscii(io_, convertedStr, signLength + digitsBeforePoint) &&
EmitRepeated(io_, '0', zeroesBeforePoint) &&
diff --git a/flang/docs/F202X.md b/flang/docs/F202X.md
index d1940a1858db1..6a303981cf264 100644
--- a/flang/docs/F202X.md
+++ b/flang/docs/F202X.md
@@ -261,6 +261,15 @@ The `AT` edit descriptor automatically trims character output. The `LZP`,
`LZS`, and `LZ` control edit descriptors and `LEADING_ZERO=` specifier provide a
means for controlling the output of leading zero digits.
+Implementation status:
+- `LZ`, `LZS`, `LZP` control edit descriptors, affect only F, E, D, and G
+ editing of an output statement: Implemented
+ - `LZ` - Processor-dependent, default (e.g., `0.2`)
+ - `LZS` - Suppress leading zeros (e.g., `.2`)
+ - `LZP` - Print leading zero (e.g. `0.2`)
+- `AT` edit descriptor: Not yet implemented
+- `LEADING_ZERO=specifier` in OPEN statement: Not yet implemented
+
#### Intrinsic Module Extensions
Addressing some issues and omissions in intrinsic modules:
diff --git a/flang/docs/FortranStandardsSupport.md b/flang/docs/FortranStandardsSupport.md
index f57956cd6d6b8..02e4653280f12 100644
--- a/flang/docs/FortranStandardsSupport.md
+++ b/flang/docs/FortranStandardsSupport.md
@@ -48,7 +48,7 @@ status of all important Fortran 2023 features. The table entries are based on th
| Extensions for c_f_pointer intrinsic | Y | |
| Procedures for converting between fortran and c strings | N | |
| The at edit descriptor | N | |
-| Control over leading zeros in output of real values | N | |
+| Control over leading zeros in output of real values | P | LZ/LZS/LZP edit descriptors implemented; LEADING_ZERO=specifier not yet implemented |
| Extensions for Namelist | N | |
| Allow an object of a type with a coarray ultimate component to be an array or allocatable | N | |
| Put with Notify | N | |
diff --git a/flang/include/flang/Common/format.h b/flang/include/flang/Common/format.h
index 1e64acb823616..60bcc8e81ee38 100644
--- a/flang/include/flang/Common/format.h
+++ b/flang/include/flang/Common/format.h
@@ -114,7 +114,7 @@ struct FormatMessage {
// This declaration is logically private to class FormatValidator.
// It is placed here to work around a clang compilation problem.
ENUM_CLASS(TokenKind, None, A, B, BN, BZ, D, DC, DP, DT, E, EN, ES, EX, F, G, I,
- L, O, P, RC, RD, RN, RP, RU, RZ, S, SP, SS, T, TL, TR, X, Z, Colon, Slash,
+ L, LZ, LZP, LZS, O, P, RC, RD, RN, RP, RU, RZ, S, SP, SS, T, TL, TR, X, Z, Colon, Slash,
Backslash, // nonstandard: inhibit newline on output
Dollar, // nonstandard: inhibit newline on output on terminals
Star, LParen, RParen, Comma, Point, Sign,
@@ -219,7 +219,7 @@ template <typename CHAR = char> class FormatValidator {
std::int64_t knrValue_{-1}; // -1 ==> not present
std::int64_t scaleFactorValue_{}; // signed k in kP
std::int64_t wValue_{-1};
- char argString_[3]{}; // 1-2 character msg arg; usually edit descriptor name
+ char argString_[4]{}; // 1-3 character msg arg; usually edit descriptor name
bool formatHasErrors_{false};
bool unterminatedFormatError_{false};
bool suppressMessageCascade_{false};
@@ -390,7 +390,25 @@ template <typename CHAR> void FormatValidator<CHAR>::NextToken() {
token_.set_kind(TokenKind::I);
break;
case 'L':
- token_.set_kind(TokenKind::L);
+ switch (LookAheadChar()) {
+ case 'Z':
+ // Advance past 'Z', then look ahead for 'S' or 'P'
+ Advance(TokenKind::LZ);
+ switch (LookAheadChar()) {
+ case 'S':
+ Advance(TokenKind::LZS);
+ break;
+ case 'P':
+ Advance(TokenKind::LZP);
+ break;
+ default:
+ break;
+ }
+ break;
+ default:
+ token_.set_kind(TokenKind::L);
+ break;
+ }
break;
case 'O':
token_.set_kind(TokenKind::O);
@@ -674,9 +692,22 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
ReportError("Unexpected '%s' in format expression", signToken);
}
// Default message argument.
- // Alphabetic edit descriptor names are one or two characters in length.
+ // Alphabetic edit descriptor names are one to three characters in length.
argString_[0] = toupper(format_[token_.offset()]);
- argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0;
+ if (token_.length() > 2) {
+ // Three-character descriptor names (e.g., LZP, LZS).
+ // token_.offset() has the first character and *cursor_ has the last;
+ // find the middle character by scanning past any blanks.
+ const CHAR *mid{format_ + token_.offset() + 1};
+ while (mid < cursor_ && IsWhite(*mid)) {
+ ++mid;
+ }
+ argString_[1] = toupper(*mid);
+ argString_[2] = toupper(*cursor_);
+ } else {
+ argString_[1] = token_.length() > 1 ? toupper(*cursor_) : 0;
+ argString_[2] = 0;
+ }
// Process one format edit descriptor or do format list management.
switch (token_.kind()) {
case TokenKind::A:
@@ -794,6 +825,9 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
case TokenKind::BZ:
case TokenKind::DC:
case TokenKind::DP:
+ case TokenKind::LZ:
+ case TokenKind::LZS:
+ case TokenKind::LZP:
case TokenKind::RC:
case TokenKind::RD:
case TokenKind::RN:
@@ -807,6 +841,7 @@ template <typename CHAR> bool FormatValidator<CHAR>::Check() {
// R1318 blank-interp-edit-desc -> BN | BZ
// R1319 round-edit-desc -> RU | RD | RZ | RN | RC | RP
// R1320 decimal-edit-desc -> DC | DP
+ // F202X leading-zero-edit-desc -> LZ | LZS | LZP
check_r(false);
NextToken();
break;
diff --git a/flang/include/flang/Parser/format-specification.h b/flang/include/flang/Parser/format-specification.h
index 28c8affd7bde0..5d37a9c2c0060 100644
--- a/flang/include/flang/Parser/format-specification.h
+++ b/flang/include/flang/Parser/format-specification.h
@@ -95,6 +95,9 @@ struct ControlEditDesc {
RP,
DC,
DP,
+ LZ, // F202X: processor-dependent leading zero, default
+ LZS, // F202X: suppress leading zeros
+ LZP, // F202X: print leading zero
Dollar, // extension: inhibit newline on output
Backslash, // ditto, but only on terminals
};
diff --git a/flang/lib/Parser/io-parsers.cpp b/flang/lib/Parser/io-parsers.cpp
index cb3e68a05c94d..6bdf6faca8915 100644
--- a/flang/lib/Parser/io-parsers.cpp
+++ b/flang/lib/Parser/io-parsers.cpp
@@ -552,6 +552,11 @@ TYPE_PARSER(construct<format::FormatItem>(
construct<format::FormatItem>(
maybe(repeat), Parser<format::DerivedTypeDataEditDesc>{}) ||
construct<format::FormatItem>(Parser<format::ControlEditDesc>{}) ||
+ // Error recovery: accept [r] before control-edit-desc so that the
+ // format validator can diagnose a repeat specifier before descriptors
+ // like SS, SP, S, BN, BZ, etc., rather than failing the parse entirely.
+ construct<format::FormatItem>(
+ maybe(repeat), Parser<format::ControlEditDesc>{}) ||
construct<format::FormatItem>(charStringEditDesc) ||
construct<format::FormatItem>(maybe(repeat), parenthesized(formatItems)))
@@ -629,7 +634,8 @@ TYPE_PARSER(construct<format::IntrinsicTypeDataEditDesc>(
"X " >> pure(format::IntrinsicTypeDataEditDesc::Kind::EX) ||
pure(format::IntrinsicTypeDataEditDesc::Kind::E)) ||
"G " >> pure(format::IntrinsicTypeDataEditDesc::Kind::G) ||
- "L " >> pure(format::IntrinsicTypeDataEditDesc::Kind::L),
+ ("L "_tok / !letter /* don't occlude LZ, LZS, & LZP */) >>
+ pure(format::IntrinsicTypeDataEditDesc::Kind::L),
noInt, noInt, noInt)))
// R1307 data-edit-desc (part 2 of 2)
@@ -677,6 +683,12 @@ TYPE_PARSER(construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::BN)) ||
"Z " >> construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::BZ))) ||
+ "L " >> ("Z " >> ("S " >> construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZS)) ||
+ "P " >> construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZP)) ||
+ construct<format::ControlEditDesc>(
+ pure(format::ControlEditDesc::Kind::LZ)))) ||
"R " >> ("U " >> construct<format::ControlEditDesc>(
pure(format::ControlEditDesc::Kind::RU)) ||
"D " >> construct<format::ControlEditDesc>(
diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp
index 3d8ea9f703b2f..8ad1f9b8ff618 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1549,6 +1549,9 @@ class UnparseVisitor {
FMT(RP);
FMT(DC);
FMT(DP);
+ FMT(LZ);
+ FMT(LZS);
+ FMT(LZP);
#undef FMT
case format::ControlEditDesc::Kind::Dollar:
Put('$');
diff --git a/flang/test/Semantics/io16.f90 b/flang/test/Semantics/io16.f90
new file mode 100644
index 0000000000000..559d98f0d5ceb
--- /dev/null
+++ b/flang/test/Semantics/io16.f90
@@ -0,0 +1,99 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+! F202X leading-zero control edit descriptors: LZ, LZS, LZP
+
+ ! Valid uses of LZ, LZP, LZS in FORMAT statements
+1001 format(LZ, F10.3)
+1002 format(LZP, F10.3)
+1003 format(LZS, F10.3)
+1004 format(LZ, E10.3)
+1005 format(LZP, E10.3)
+1006 format(LZS, E10.3)
+1007 format(LZS, D10.3)
+1008 format(LZ, G10.3)
+
+ ! Valid uses with blanks inside keywords (Fortran ignores blanks)
+1009 format(L Z, F10.3)
+1010 format(L Z P, F10.3)
+1011 format(L Z S, F10.3)
+
+ ! Combining with other control edit descriptors
+1012 format(LZP, DC, F10.3)
+1013 format(BN, LZS, F10.3)
+1014 format(LZ, SS, RZ, F10.3)
+
+ ! Multiple groups
+1015 format(LZP, 3F10.3, LZS, 2E12.4)
+
+ ! C1302 : multiple edit descriptors without ',' separation; no errors
+1016 format(LZF10.3)
+1017 format(LZPF10.3)
+1018 format(LZSF10.3)
+1019 format(LZE10.3)
+1020 format(LZPE10.3)
+1021 format(LZSD10.3)
+1022 format(LZG10.3)
+1023 format(LZPDCF10.3)
+1024 format(BNLZSF10.3)
+1025 format(LZPF10.3LZSF10.3)
+1026 format(LZP3F10.3LZS2E12.4)
+
+ ! In WRITE format strings
+ write(*, '(LZ, F10.3)') 0.5
+ write(*, '(LZP, F10.3)') 0.5
+ write(*, '(LZS, F10.3)') 0.5
+ write(*, '(LZP,E10.3)') 0.5
+ write(*, '(LZS,D10.3)') 0.5
+
+ ! C1302 : WRITE format strings without ',' separation; no errors
+ write(*, '(LZF10.3)') 0.5
+ write(*, '(LZPF10.3)') 0.5
+ write(*, '(LZSF10.3)') 0.5
+ write(*, '(LZPE10.3)') 0.5
+ write(*, '(LZP3F10.3LZS2E12.4)') 0.5, 0.5, 0.5, 0.5, 0.5
+
+ ! FMT= specifier with comma-separated descriptors
+ write(*, fmt='(LZ, F10.3)') 0.5
+ write(*, fmt='(LZP, F10.3)') 0.5
+ write(*, fmt='(LZS, F10.3)') 0.5
+ write(*, fmt='(LZP, E10.3)') 0.5
+ write(*, fmt='(LZS, D10.3)') 0.5
+ write(*, fmt='(LZP, DC, F10.3)') 0.5
+ write(*, fmt='(BN, LZS, F10.3)') 0.5
+
+ ! FMT= specifier without ',' separation; no errors
+ write(*, fmt='(LZF10.3)') 0.5
+ write(*, fmt='(LZPF10.3)') 0.5
+ write(*, fmt='(LZSF10.3)') 0.5
+ write(*, fmt='(LZPE10.3)') 0.5
+ write(*, fmt='(LZP3F10.3LZS2E12.4)') 0.5, 0.5, 0.5, 0.5, 0.5
+
+ ! FMT= specifier with FORMAT label reference
+ write(*, fmt=1001) 0.5
+ write(*, fmt=1002) 0.5
+ write(*, fmt=1017) 0.5
+
+ ! LZ/LZP/LZS coexisting with abbreviated L (no width) data edit descriptor
+ write(*, '(LZP, F10.3, L)') 0.5, .true.
+ write(*, '(LZS, F10.3, L)') 0.5, .true.
+
+ ! Error: repeat specifier before LZ/LZP/LZS in WRITE format strings
+ !ERROR: Repeat specifier before 'LZ' edit descriptor
+ write(*, '(3LZ, F10.3)') 0.5
+
+ !ERROR: Repeat specifier before 'LZP' edit descriptor
+ write(*, '(2LZP, F10.3)') 0.5
+
+ !ERROR: Repeat specifier before 'LZS' edit descriptor
+ write(*, '(2LZS, F10.3)') 0.5
+
+ ! Error: repeat specifier before LZ/LZP/LZS in FORMAT statements
+ !ERROR: Repeat specifier before 'LZ' edit descriptor
+2001 format(3LZ, F10.3)
+
+ !ERROR: Repeat specifier before 'LZP' edit descriptor
+2002 format(2LZP, F10.3)
+
+ !ERROR: Repeat specifier before 'LZS' edit descriptor
+2003 format(2LZS, F10.3)
+end
|
|
This PR actually include PR #183500. |
61e07f6 to
c698a10
Compare
|
As a stand-along PR, it needs a test that shows what's fixed. |
A compile-time test, flang/test/Semantics/io17.f90, has been added. |
eugeneepshteyn
left a comment
There was a problem hiding this comment.
LGTM, but let's have at least one more review.
|
What about the case of this error showing up in a character literal or named constant format? |
The test, io17.f90, has been updated to cover all the cases I can think of. |
|
Thank @eugeneepshteyn and @klausler for approving the PR. Would you please help to merge it? Integration of this PR will help other PRs (PR #183500 and llvm-test-suite PR #362) to move forward. Or should we still wait for @akuhlens to approve? |
|
I'll merge after I give it a quick test. Andre can always do a post-commit review. |
|
@laoshd Congratulations on having your first Pull Request (PR) merged into the LLVM Project! Your changes will be combined with recent changes from other authors, then tested by our build bots. If there is a problem with a build, you may receive a report in an email or a comment on this PR. Please check whether problems have been caused by your change specifically, as the builds can include changes from many authors. It is not uncommon for your change to be included in a build that fails due to someone else's changes, or infrastructure issues. How to do this, and the rest of the post-merge process, is covered in detail here. If your change does cause a problem, it may be reverted, or you can revert it yourself. This is a normal part of LLVM development. You can fix your changes and open a new PR to merge them again. If you don't get any reports, no action is required from you. Your changes are working as expected, well done! |
|
Thank you all for help of making my first contribution to Flang become true. |
Fix the problem described in issue #178494. It will cover the failures with S, SP, SS, BN, BZ, LZ, LZP, LZS, etc. It will resolve the test failures in PR #183500.