[flang-commits] [flang] 6e5e1c9 - [flang][flang-rt] Implement F202X leading-zero control edit descriptors LZ, LZS, and LZP for formatted output (F, E, D, and G editing) (#183500)
via flang-commits
flang-commits at lists.llvm.org
Mon Mar 23 08:50:53 PDT 2026
Author: laoshd
Date: 2026-03-23T11:50:48-04:00
New Revision: 6e5e1c97e024582bcca8eccf9b78f3b5d0991024
URL: https://github.com/llvm/llvm-project/commit/6e5e1c97e024582bcca8eccf9b78f3b5d0991024
DIFF: https://github.com/llvm/llvm-project/commit/6e5e1c97e024582bcca8eccf9b78f3b5d0991024.diff
LOG: [flang][flang-rt] Implement F202X leading-zero control edit descriptors LZ, LZS, and LZP for formatted output (F, E, D, and G editing) (#183500)
LZ: processor-dependent (default, flang prints leading zero); LZS:
suppress the optional leading zero before the decimal point; LZP: print
the optional leading zero before the decimal point. Changes span the
source parser, compile-time format validator, runtime format processing,
and runtime output formatting. Includes semantic test (io18.f90) and
documentation updates.
Added:
flang-rt/unittests/Runtime/LeadingZeroTest.cpp
flang/test/Semantics/io18.f90
Modified:
flang-rt/include/flang-rt/runtime/format-implementation.h
flang-rt/include/flang-rt/runtime/format.h
flang-rt/lib/runtime/edit-output.cpp
flang-rt/lib/runtime/io-api.cpp
flang-rt/lib/runtime/io-stmt.cpp
flang-rt/unittests/Runtime/CMakeLists.txt
flang/docs/F202X.md
flang/docs/FortranStandardsSupport.md
flang/include/flang/Common/format.h
flang/include/flang/Optimizer/Transforms/RuntimeFunctions.inc
flang/include/flang/Parser/format-specification.h
flang/include/flang/Parser/parse-tree.h
flang/include/flang/Runtime/io-api.h
flang/include/flang/Support/Fortran.h
flang/lib/Lower/IO.cpp
flang/lib/Parser/io-parsers.cpp
flang/lib/Parser/unparse.cpp
flang/lib/Semantics/check-io.cpp
flang/test/Transforms/set-runtime-call-attributes.fir
flang/test/Transforms/verify-known-runtime-functions.fir
Removed:
################################################################################
diff --git a/flang-rt/include/flang-rt/runtime/format-implementation.h b/flang-rt/include/flang-rt/runtime/format-implementation.h
index d510adbb5ba46..812802b07ac9f 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, char next2, int n) {
MutableModes &modes{context.mutableModes()};
switch (ch) {
case 'B':
@@ -251,6 +251,16 @@ static RT_API_ATTRS void HandleControl(
return;
}
break;
+ case 'L':
+ if (next == 'Z') {
+ if (next2 == 'S') {
+ modes.editingFlags |= leadingZeroSuppress; // LZS
+ } else {
+ modes.editingFlags &= ~leadingZeroSuppress; // LZ or LZP
+ }
+ return;
+ }
+ break;
case 'S':
if (next == 'P') {
modes.editingFlags |= signPlus;
@@ -455,6 +465,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 +475,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 +504,7 @@ RT_API_ATTRS int FormatControl<CONTEXT>::CueUpNextDataEdit(
repeat = GetIntField(context);
}
HandleControl(context, static_cast<char>(ch), static_cast<char>(next),
- repeat ? *repeat : 1);
+ static_cast<char>(next2), repeat ? *repeat : 1);
}
} 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..c36abaaf15b55 100644
--- a/flang-rt/include/flang-rt/runtime/format.h
+++ b/flang-rt/include/flang-rt/runtime/format.h
@@ -33,6 +33,7 @@ enum EditingFlags {
blankZero = 1, // BLANK=ZERO or BZ edit
decimalComma = 2, // DECIMAL=COMMA or DC edit
signPlus = 4, // SIGN=PLUS or SP edit
+ leadingZeroSuppress = 8, // LZS edit; clear for LZ & LZP
};
struct MutableModes {
@@ -44,7 +45,7 @@ struct MutableModes {
return editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
}
- std::uint8_t editingFlags{0}; // BN, DP, SS
+ std::uint8_t editingFlags{0}; // BN, DP, SS, LZS
enum decimal::FortranRounding round{
executionEnvironment
.defaultOutputRoundingMode}; // RP/ROUND='PROCESSOR_DEFAULT'
diff --git a/flang-rt/lib/runtime/edit-output.cpp b/flang-rt/lib/runtime/edit-output.cpp
index 78fb2499cc590..ded76f073aa1a 100644
--- a/flang-rt/lib/runtime/edit-output.cpp
+++ b/flang-rt/lib/runtime/edit-output.cpp
@@ -420,7 +420,8 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditEorDOutput(
return EmitRepeated(io_, '*', width);
}
if (totalLength < width && digitsBeforePoint == 0 &&
- zeroesBeforePoint == 0) {
+ zeroesBeforePoint == 0 &&
+ !(edit.modes.editingFlags & leadingZeroSuppress)) {
zeroesBeforePoint = 1;
++totalLength;
}
@@ -552,7 +553,7 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (digitsBeforePoint + zeroesBeforePoint + zeroesAfterPoint +
digitsAfterPoint + trailingZeroes ==
0) {
- zeroesBeforePoint = 1; // "." -> "0."
+ zeroesBeforePoint = 1; // "." -> "0." (avoid bare decimal point)
}
int totalLength{signLength + digitsBeforePoint + zeroesBeforePoint +
1 /*'.'*/ + zeroesAfterPoint + digitsAfterPoint + trailingZeroes +
@@ -561,7 +562,8 @@ RT_API_ATTRS bool RealOutputEditing<KIND>::EditFOutput(const DataEdit &edit) {
if (totalLength > width) {
return EmitRepeated(io_, '*', width);
}
- if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0) {
+ if (totalLength < width && digitsBeforePoint + zeroesBeforePoint == 0 &&
+ !(edit.modes.editingFlags & leadingZeroSuppress)) {
zeroesBeforePoint = 1;
++totalLength;
}
diff --git a/flang-rt/lib/runtime/io-api.cpp b/flang-rt/lib/runtime/io-api.cpp
index f2a1666a0571d..aa3ad9254fe0c 100644
--- a/flang-rt/lib/runtime/io-api.cpp
+++ b/flang-rt/lib/runtime/io-api.cpp
@@ -688,6 +688,29 @@ bool IODEF(SetSign)(Cookie cookie, const char *keyword, std::size_t length) {
}
}
+bool IODEF(SetLeadingZero)(
+ Cookie cookie, const char *keyword, std::size_t length) {
+ IoStatementState &io{*cookie};
+ if (auto *open{io.get_if<OpenStatementState>()}) {
+ open->set_mustBeFormatted();
+ }
+ static const char *keywords[]{
+ "PRINT", "PROCESSOR_DEFINED", "SUPPRESS", nullptr};
+ switch (IdentifyValue(keyword, length, keywords)) {
+ case 0: // LZP, print leading zero, if the field has room for it
+ case 1: // LZ, processor default, treated as LZP
+ io.mutableModes().editingFlags &= ~leadingZeroSuppress;
+ return true;
+ case 2:
+ io.mutableModes().editingFlags |= leadingZeroSuppress;
+ return true;
+ default:
+ io.GetIoErrorHandler().SignalError(IostatErrorInKeyword,
+ "Invalid LEADING_ZERO='%.*s'", static_cast<int>(length), keyword);
+ return false;
+ }
+}
+
bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) {
IoStatementState &io{*cookie};
auto *open{io.get_if<OpenStatementState>()};
diff --git a/flang-rt/lib/runtime/io-stmt.cpp b/flang-rt/lib/runtime/io-stmt.cpp
index 6d3b01af6c792..9eb2dad8e457d 100644
--- a/flang-rt/lib/runtime/io-stmt.cpp
+++ b/flang-rt/lib/runtime/io-stmt.cpp
@@ -1278,6 +1278,12 @@ bool InquireUnitState::Inquire(
: mutableModes().editingFlags & decimalComma ? "COMMA"
: "POINT";
break;
+ case HashInquiryKeyword("Leading_Zero"):
+ str = !unit().IsConnected() || unit().isUnformatted.value_or(true)
+ ? "UNDEFINED"
+ : mutableModes().editingFlags & leadingZeroSuppress ? "SUPPRESS"
+ : "PRINT";
+ break;
case HashInquiryKeyword("DELIM"):
if (!unit().IsConnected() || unit().isUnformatted.value_or(true)) {
str = "UNDEFINED";
@@ -1503,6 +1509,7 @@ bool InquireNoUnitState::Inquire(
case HashInquiryKeyword("DECIMAL"):
case HashInquiryKeyword("DELIM"):
case HashInquiryKeyword("FORM"):
+ case HashInquiryKeyword("Leading_Zero"):
case HashInquiryKeyword("NAME"):
case HashInquiryKeyword("PAD"):
case HashInquiryKeyword("POSITION"):
@@ -1591,6 +1598,7 @@ bool InquireUnconnectedFileState::Inquire(
case HashInquiryKeyword("DECIMAL"):
case HashInquiryKeyword("DELIM"):
case HashInquiryKeyword("FORM"):
+ case HashInquiryKeyword("Leading_Zero"):
case HashInquiryKeyword("PAD"):
case HashInquiryKeyword("POSITION"):
case HashInquiryKeyword("ROUND"):
diff --git a/flang-rt/unittests/Runtime/CMakeLists.txt b/flang-rt/unittests/Runtime/CMakeLists.txt
index fca064b226200..31f7fcb5da812 100644
--- a/flang-rt/unittests/Runtime/CMakeLists.txt
+++ b/flang-rt/unittests/Runtime/CMakeLists.txt
@@ -22,6 +22,7 @@ add_flangrt_unittest(RuntimeTests
Format.cpp
InputExtensions.cpp
Inquiry.cpp
+ LeadingZeroTest.cpp
ListInputTest.cpp
LogicalFormatTest.cpp
Matmul.cpp
diff --git a/flang-rt/unittests/Runtime/LeadingZeroTest.cpp b/flang-rt/unittests/Runtime/LeadingZeroTest.cpp
new file mode 100644
index 0000000000000..2a8e715190bc1
--- /dev/null
+++ b/flang-rt/unittests/Runtime/LeadingZeroTest.cpp
@@ -0,0 +1,379 @@
+//===-- unittests/Runtime/LeadingZeroTest.cpp --------------------*- C++
+//-*-===//
+//
+// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
+// See https://llvm.org/LICENSE.txt for license information.
+// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
+//
+//===----------------------------------------------------------------------===//
+//
+// Tests for F202X leading-zero control edit descriptors: LZ, LZP, LZS.
+// LZ - processor-dependent (flang prints leading zero)
+// LZP - print the optional leading zero
+// LZS - suppress the optional leading zero
+//
+//===----------------------------------------------------------------------===//
+
+#include "CrashHandlerFixture.h"
+#include "flang-rt/runtime/descriptor.h"
+#include "flang/Runtime/io-api.h"
+#include <algorithm>
+#include <cstring>
+#include <gtest/gtest.h>
+#include <string>
+#include <tuple>
+#include <vector>
+
+using namespace Fortran::runtime;
+using namespace Fortran::runtime::io;
+
+static bool CompareFormattedStrings(
+ const std::string &expect, const std::string &got) {
+ std::string want{expect};
+ want.resize(got.size(), ' ');
+ return want == got;
+}
+
+// Perform format on a double and return the trimmed result
+static std::string FormatReal(const char *format, double x) {
+ char buffer[800];
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, x));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ return got;
+}
+
+static bool CompareFormatReal(
+ const char *format, double x, const char *expect, std::string &got) {
+ got = FormatReal(format, x);
+ return CompareFormattedStrings(expect, got);
+}
+
+struct LeadingZeroTests : CrashHandlerFixture {};
+
+// LZP with F editing: value < 1 should print "0." before decimal digits
+TEST_F(LeadingZeroTests, LZP_F_editing) {
+ static constexpr std::pair<const char *, const char *> cases[]{
+ {"(LZP,F6.1)", " 0.2"},
+ {"(LZP,F10.3)", " 0.200"},
+ {"(LZP,F6.1)", " 0.5"},
+ {"(LZP,F4.1)", " 0.1"},
+ };
+ double values[]{0.2, 0.2, 0.5, 0.1};
+ for (int i = 0; i < 4; ++i) {
+ std::string got;
+ ASSERT_TRUE(
+ CompareFormatReal(cases[i].first, values[i], cases[i].second, got))
+ << "Failed: format=" << cases[i].first << " value=" << values[i]
+ << ", expected '" << cases[i].second << "', got '" << got << "'";
+ }
+}
+
+// LZS with F editing: value < 1 should suppress the leading zero
+TEST_F(LeadingZeroTests, LZS_F_editing) {
+ static constexpr std::pair<const char *, const char *> cases[]{
+ {"(LZS,F6.1)", " .2"},
+ {"(LZS,F10.3)", " .200"},
+ {"(LZS,F6.1)", " .5"},
+ {"(LZS,F4.1)", " .1"},
+ };
+ double values[]{0.2, 0.2, 0.5, 0.1};
+ for (int i = 0; i < 4; ++i) {
+ std::string got;
+ ASSERT_TRUE(
+ CompareFormatReal(cases[i].first, values[i], cases[i].second, got))
+ << "Failed: format=" << cases[i].first << " value=" << values[i]
+ << ", expected '" << cases[i].second << "', got '" << got << "'";
+ }
+}
+
+// LZ (processor-dependent, flang prints leading zero) with F editing
+TEST_F(LeadingZeroTests, LZ_F_editing) {
+ static constexpr std::pair<const char *, const char *> cases[]{
+ {"(LZ,F6.1)", " 0.2"},
+ {"(LZ,F10.3)", " 0.200"},
+ };
+ double values[]{0.2, 0.2};
+ for (int i = 0; i < 2; ++i) {
+ std::string got;
+ ASSERT_TRUE(
+ CompareFormatReal(cases[i].first, values[i], cases[i].second, got))
+ << "Failed: format=" << cases[i].first << " value=" << values[i]
+ << ", expected '" << cases[i].second << "', got '" << got << "'";
+ }
+}
+
+// LZP with E editing: value < 1 should print "0." before decimal digits
+TEST_F(LeadingZeroTests, LZP_E_editing) {
+ static constexpr std::pair<const char *, const char *> cases[]{
+ {"(LZP,E10.3)", " 0.200E+00"},
+ {"(LZP,E12.5)", " 0.20000E+00"},
+ };
+ double values[]{0.2, 0.2};
+ for (int i = 0; i < 2; ++i) {
+ std::string got;
+ ASSERT_TRUE(
+ CompareFormatReal(cases[i].first, values[i], cases[i].second, got))
+ << "Failed: format=" << cases[i].first << " value=" << values[i]
+ << ", expected '" << cases[i].second << "', got '" << got << "'";
+ }
+}
+
+// LZS with E editing: value < 1 should suppress the leading zero
+TEST_F(LeadingZeroTests, LZS_E_editing) {
+ static constexpr std::pair<const char *, const char *> cases[]{
+ {"(LZS,E10.3)", " .200E+00"},
+ {"(LZS,E12.5)", " .20000E+00"},
+ };
+ double values[]{0.2, 0.2};
+ for (int i = 0; i < 2; ++i) {
+ std::string got;
+ ASSERT_TRUE(
+ CompareFormatReal(cases[i].first, values[i], cases[i].second, got))
+ << "Failed: format=" << cases[i].first << " value=" << values[i]
+ << ", expected '" << cases[i].second << "', got '" << got << "'";
+ }
+}
+
+// LZP with D editing
+TEST_F(LeadingZeroTests, LZP_D_editing) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZP,D10.3)", 0.2, " 0.200D+00", got))
+ << "Expected ' 0.200D+00', got '" << got << "'";
+}
+
+// LZS with D editing
+TEST_F(LeadingZeroTests, LZS_D_editing) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZS,D10.3)", 0.2, " .200D+00", got))
+ << "Expected ' .200D+00', got '" << got << "'";
+}
+
+// LZP with G editing — G routes to F when exponent is in range
+TEST_F(LeadingZeroTests, LZP_G_editing_F_path) {
+ std::string got;
+ // 0.2 with G10.3: exponent 0 is in [0,3], so G uses F editing
+ ASSERT_TRUE(CompareFormatReal("(LZP,G10.3)", 0.2, " 0.200 ", got))
+ << "Expected ' 0.200 ', got '" << got << "'";
+}
+
+// LZS with G editing — G routes to F when exponent is in range
+TEST_F(LeadingZeroTests, LZS_G_editing_F_path) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZS,G10.3)", 0.2, " .200 ", got))
+ << "Expected ' .200 ', got '" << got << "'";
+}
+
+// LZP with G editing — G routes to E when exponent is out of range
+TEST_F(LeadingZeroTests, LZP_G_editing_E_path) {
+ std::string got;
+ // 0.0002 with G10.3: exponent -3 is < 0, so G uses E editing
+ ASSERT_TRUE(CompareFormatReal("(LZP,G10.3)", 0.0002, " 0.200E-03", got))
+ << "Expected ' 0.200E-03', got '" << got << "'";
+}
+
+// LZS with G editing — G routes to E when exponent is out of range
+TEST_F(LeadingZeroTests, LZS_G_editing_E_path) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZS,G10.3)", 0.0002, " .200E-03", got))
+ << "Expected ' .200E-03', got '" << got << "'";
+}
+
+// Switching between LZP and LZS in the same format
+TEST_F(LeadingZeroTests, SwitchBetweenLZPandLZS) {
+ char buffer[800];
+ const char *format{"(LZP,F6.1,LZS,F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ std::string expect{" 0.5 .5"};
+ ASSERT_TRUE(CompareFormattedStrings(expect, got))
+ << "Expected '" << expect << "', got '" << got << "'";
+}
+
+// LZP/LZS with negative values < 1 in magnitude
+TEST_F(LeadingZeroTests, NegativeValues) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZP,F7.1)", -0.2, " -0.2", got))
+ << "Expected ' -0.2', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZS,F7.1)", -0.2, " -.2", got))
+ << "Expected ' -.2', got '" << got << "'";
+}
+
+// LZP/LZS should not affect values >= 1 (leading zero is not optional)
+TEST_F(LeadingZeroTests, ValuesGreaterThanOne) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZP,F6.1)", 1.2, " 1.2", got))
+ << "Expected ' 1.2', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZS,F6.1)", 1.2, " 1.2", got))
+ << "Expected ' 1.2', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZP,F6.1)", 12.3, " 12.3", got))
+ << "Expected ' 12.3', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZS,F6.1)", 12.3, " 12.3", got))
+ << "Expected ' 12.3', got '" << got << "'";
+}
+
+// LZP/LZS with zero value
+TEST_F(LeadingZeroTests, ZeroValue) {
+ std::string got;
+ // LZP: zero value still prints leading zero before decimal point
+ ASSERT_TRUE(CompareFormatReal("(LZP,F6.1)", 0.0, " 0.0", got))
+ << "Expected ' 0.0', got '" << got << "'";
+ // LZS: zero has magnitude < 1, so the leading zero is optional and suppressed
+ ASSERT_TRUE(CompareFormatReal("(LZS,F6.1)", 0.0, " .0", got))
+ << "Expected ' .0', got '" << got << "'";
+}
+
+// LZP/LZS with scale factor (1P) — leading zero not optional when scale > 0
+TEST_F(LeadingZeroTests, WithScaleFactor) {
+ std::string got;
+ // With 1P, E editing puts one digit before the decimal point,
+ // so LZS should not suppress it (it's not an optional zero)
+ ASSERT_TRUE(CompareFormatReal("(LZP,1P,E10.3)", 0.2, " 2.000E-01", got))
+ << "Expected ' 2.000E-01', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZS,1P,E10.3)", 0.2, " 2.000E-01", got))
+ << "Expected ' 2.000E-01', got '" << got << "'";
+}
+
+// LZP without comma separator (C1302 extension)
+TEST_F(LeadingZeroTests, WithoutCommaSeparator) {
+ std::string got;
+ ASSERT_TRUE(CompareFormatReal("(LZPF6.1)", 0.2, " 0.2", got))
+ << "Expected ' 0.2', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZSF6.1)", 0.2, " .2", got))
+ << "Expected ' .2', got '" << got << "'";
+ ASSERT_TRUE(CompareFormatReal("(LZF6.1)", 0.2, " 0.2", got))
+ << "Expected ' 0.2', got '" << got << "'";
+}
+
+// LEADING_ZERO= specifier via SetLeadingZero runtime API
+TEST_F(LeadingZeroTests, SetLeadingZero_Suppress) {
+ // LEADING_ZERO='SUPPRESS' should suppress the optional leading zero
+ char buffer[800];
+ const char *format{"(F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ IONAME(SetLeadingZero)(cookie, "SUPPRESS", 8);
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" .5", got))
+ << "Expected ' .5', got '" << got << "'";
+}
+
+TEST_F(LeadingZeroTests, SetLeadingZero_Print) {
+ // LEADING_ZERO='PRINT' should print the optional leading zero
+ char buffer[800];
+ const char *format{"(F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ IONAME(SetLeadingZero)(cookie, "PRINT", 5);
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" 0.5", got))
+ << "Expected ' 0.5', got '" << got << "'";
+}
+
+TEST_F(LeadingZeroTests, SetLeadingZero_ProcessorDefined) {
+ // LEADING_ZERO='PROCESSOR_DEFINED' should behave like PRINT (flang default)
+ char buffer[800];
+ const char *format{"(F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ IONAME(SetLeadingZero)(cookie, "PROCESSOR_DEFINED", 17);
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" 0.5", got))
+ << "Expected ' 0.5', got '" << got << "'";
+}
+
+// LEADING_ZERO= overridden by LZS/LZP edit descriptors in format
+TEST_F(LeadingZeroTests, SetLeadingZero_OverriddenByEditDescriptor) {
+ // Set LEADING_ZERO='PRINT' but format uses LZS — LZS should win
+ char buffer[800];
+ const char *format{"(LZS,F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ IONAME(SetLeadingZero)(cookie, "PRINT", 5);
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" .5", got))
+ << "Expected ' .5', got '" << got << "'";
+}
+
+// LEADING_ZERO= specifier via SetLeadingZero runtime API
+TEST_F(LeadingZeroTests, SetLeadingZeroSuppressViaAPI) {
+ char buffer[800];
+ const char *format{"(F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ // Set LEADING_ZERO='SUPPRESS'
+ EXPECT_TRUE(IONAME(SetLeadingZero)(cookie, "SUPPRESS", 8));
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" .5", got))
+ << "Expected ' .5', got '" << got << "'";
+}
+
+TEST_F(LeadingZeroTests, SetLeadingZeroPrintViaAPI) {
+ char buffer[800];
+ const char *format{"(F6.1)"};
+ auto cookie{IONAME(BeginInternalFormattedOutput)(
+ buffer, sizeof buffer, format, std::strlen(format))};
+ // Set LEADING_ZERO='PRINT'
+ EXPECT_TRUE(IONAME(SetLeadingZero)(cookie, "PRINT", 5));
+ EXPECT_TRUE(IONAME(OutputReal64)(cookie, 0.5));
+ auto status{IONAME(EndIoStatement)(cookie)};
+ EXPECT_EQ(status, 0);
+ std::string got{buffer, sizeof buffer};
+ auto lastNonBlank{got.find_last_not_of(" ")};
+ if (lastNonBlank != std::string::npos) {
+ got.resize(lastNonBlank + 1);
+ }
+ ASSERT_TRUE(CompareFormattedStrings(" 0.5", got))
+ << "Expected ' 0.5', got '" << got << "'";
+}
diff --git a/flang/docs/F202X.md b/flang/docs/F202X.md
index 988c0e9f083e0..462f6040f9cea 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 (flang treats as LZP)
+ - `LZS` - Suppress leading zero (e.g., `.2`)
+ - `LZP` - Print leading zero when the field is wide enough (e.g., `0.2`)
+- `AT` edit descriptor: Not yet implemented
+- `LEADING_ZERO=` specifier in OPEN, WRITE and INQUIRE statements: 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 8a04510918e62..a52d123183b59 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 | Y | |
| 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 1ddca2c706ede..7c9a763d86bae 100644
--- a/flang/include/flang/Common/format.h
+++ b/flang/include/flang/Common/format.h
@@ -114,7 +114,8 @@ 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 +220,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 +391,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 +693,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 +826,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 +842,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/Optimizer/Transforms/RuntimeFunctions.inc b/flang/include/flang/Optimizer/Transforms/RuntimeFunctions.inc
index cb4bf4ecf559d..22243c96eced0 100644
--- a/flang/include/flang/Optimizer/Transforms/RuntimeFunctions.inc
+++ b/flang/include/flang/Optimizer/Transforms/RuntimeFunctions.inc
@@ -96,6 +96,7 @@ KNOWN_IO_FUNC(SetDelim),
KNOWN_IO_FUNC(SetEncoding),
KNOWN_IO_FUNC(SetFile),
KNOWN_IO_FUNC(SetForm),
+KNOWN_IO_FUNC(SetLeadingZero),
KNOWN_IO_FUNC(SetPad),
KNOWN_IO_FUNC(SetPos),
KNOWN_IO_FUNC(SetPosition),
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/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 4aec99c80bdae..a0106cac84620 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -2630,6 +2630,7 @@ using FileNameExpr = ScalarDefaultCharExpr;
// ENCODING = scalar-default-char-expr | ERR = label |
// FILE = file-name-expr | FORM = scalar-default-char-expr |
// IOMSG = iomsg-variable | IOSTAT = scalar-int-variable |
+// LEADING_ZERO = scalar-default-char-expr |
// NEWUNIT = scalar-int-variable | PAD = scalar-default-char-expr |
// POSITION = scalar-default-char-expr | RECL = scalar-int-expr |
// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
@@ -2644,7 +2645,7 @@ struct ConnectSpec {
UNION_CLASS_BOILERPLATE(ConnectSpec);
struct CharExpr {
ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
- Encoding, Form, Pad, Position, Round, Sign,
+ Encoding, Form, Leading_Zero, Pad, Position, Round, Sign,
/* extensions: */ Carriagecontrol, Convert, Dispose)
TUPLE_CLASS_BOILERPLATE(CharExpr);
std::tuple<Kind, ScalarDefaultCharExpr> t;
@@ -2692,7 +2693,9 @@ WRAPPER_CLASS(IdVariable, ScalarIntVariable);
// DECIMAL = scalar-default-char-expr |
// DELIM = scalar-default-char-expr | END = label | EOR = label |
// ERR = label | ID = id-variable | IOMSG = iomsg-variable |
-// IOSTAT = scalar-int-variable | PAD = scalar-default-char-expr |
+// IOSTAT = scalar-int-variable |
+// LEADING_ZERO = scalar-default-char-expr |
+// PAD = scalar-default-char-expr |
// POS = scalar-int-expr | REC = scalar-int-expr |
// ROUND = scalar-default-char-expr | SIGN = scalar-default-char-expr |
// SIZE = scalar-int-variable
@@ -2701,7 +2704,8 @@ WRAPPER_CLASS(EorLabel, Label);
struct IoControlSpec {
UNION_CLASS_BOILERPLATE(IoControlSpec);
struct CharExpr {
- ENUM_CLASS(Kind, Advance, Blank, Decimal, Delim, Pad, Round, Sign)
+ ENUM_CLASS(
+ Kind, Advance, Blank, Decimal, Delim, Leading_Zero, Pad, Round, Sign)
TUPLE_CLASS_BOILERPLATE(CharExpr);
std::tuple<Kind, ScalarDefaultCharExpr> t;
};
@@ -2837,6 +2841,7 @@ WRAPPER_CLASS(FlushStmt, std::list<PositionOrFlushSpec>);
// FORMATTED = scalar-default-char-variable |
// ID = scalar-int-expr | IOMSG = iomsg-variable |
// IOSTAT = scalar-int-variable |
+// LEADING_ZERO = scalar-default-char-variable |
// NAME = scalar-default-char-variable |
// NAMED = scalar-logical-variable |
// NEXTREC = scalar-int-variable | NUMBER = scalar-int-variable |
@@ -2861,8 +2866,9 @@ struct InquireSpec {
UNION_CLASS_BOILERPLATE(InquireSpec);
struct CharVar {
ENUM_CLASS(Kind, Access, Action, Asynchronous, Blank, Decimal, Delim,
- Direct, Encoding, Form, Formatted, Iomsg, Name, Pad, Position, Read,
- Readwrite, Round, Sequential, Sign, Stream, Status, Unformatted, Write,
+ Direct, Encoding, Form, Formatted, Iomsg, Leading_Zero, Name, Pad,
+ Position, Read, Readwrite, Round, Sequential, Sign, Stream, Status,
+ Unformatted, Write,
/* extensions: */ Carriagecontrol, Convert, Dispose)
TUPLE_CLASS_BOILERPLATE(CharVar);
std::tuple<Kind, ScalarDefaultCharVariable> t;
diff --git a/flang/include/flang/Runtime/io-api.h b/flang/include/flang/Runtime/io-api.h
index fe49af2f61683..86cd4490c2990 100644
--- a/flang/include/flang/Runtime/io-api.h
+++ b/flang/include/flang/Runtime/io-api.h
@@ -238,6 +238,8 @@ bool IODECL(SetRec)(Cookie, std::int64_t);
bool IODECL(SetRound)(Cookie, const char *, std::size_t);
// SIGN=PLUS, SUPPRESS, PROCESSOR_DEFINED
bool IODECL(SetSign)(Cookie, const char *, std::size_t);
+// LEADING_ZERO=PRINT, PROCESSOR_DEFINED, SUPPRESS
+bool IODECL(SetLeadingZero)(Cookie, const char *, std::size_t);
// Data item transfer for modes other than NAMELIST:
// Any data object that can be passed as an actual argument without the
@@ -298,8 +300,8 @@ bool IODECL(InputDerivedType)(
// Additional specifier interfaces for the connection-list of
// on OPEN statement (only). SetBlank(), SetDecimal(),
-// SetDelim(), GetIoMsg(), SetPad(), SetRound(), SetSign(),
-// & SetAsynchronous() are also acceptable for OPEN.
+// SetDelim(), GetIoMsg(), SetLeadingZero(), SetPad(), SetRound(),
+// SetSign(), & SetAsynchronous() are also acceptable for OPEN.
// ACCESS=SEQUENTIAL, DIRECT, STREAM
bool IODECL(SetAccess)(Cookie, const char *, std::size_t);
// ACTION=READ, WRITE, or READWRITE
diff --git a/flang/include/flang/Support/Fortran.h b/flang/include/flang/Support/Fortran.h
index 5ca7882da32fd..dc6f7ec900e74 100644
--- a/flang/include/flang/Support/Fortran.h
+++ b/flang/include/flang/Support/Fortran.h
@@ -48,9 +48,9 @@ ENUM_CLASS(Intent, Default, In, Out, InOut)
// Union of specifiers for all I/O statements.
ENUM_CLASS(IoSpecKind, Access, Action, Advance, Asynchronous, Blank, Decimal,
Delim, Direct, Encoding, End, Eor, Err, Exist, File, Fmt, Form, Formatted,
- Id, Iomsg, Iostat, Name, Named, Newunit, Nextrec, Nml, Number, Opened, Pad,
- Pending, Pos, Position, Read, Readwrite, Rec, Recl, Round, Sequential, Sign,
- Size, Status, Stream, Unformatted, Unit, Write,
+ Id, Iomsg, Iostat, Leading_Zero, Name, Named, Newunit, Nextrec, Nml, Number,
+ Opened, Pad, Pending, Pos, Position, Read, Readwrite, Rec, Recl, Round,
+ Sequential, Sign, Size, Status, Stream, Unformatted, Unit, Write,
Carriagecontrol, // nonstandard
Convert, // nonstandard
Dispose, // nonstandard
diff --git a/flang/lib/Lower/IO.cpp b/flang/lib/Lower/IO.cpp
index de2afb70636d5..d9bbf12dc108b 100644
--- a/flang/lib/Lower/IO.cpp
+++ b/flang/lib/Lower/IO.cpp
@@ -84,9 +84,10 @@ static constexpr std::tuple<
mkIOKey(SetAccess), mkIOKey(SetAction), mkIOKey(SetAdvance),
mkIOKey(SetAsynchronous), mkIOKey(SetBlank), mkIOKey(SetCarriagecontrol),
mkIOKey(SetConvert), mkIOKey(SetDecimal), mkIOKey(SetDelim),
- mkIOKey(SetEncoding), mkIOKey(SetFile), mkIOKey(SetForm), mkIOKey(SetPad),
- mkIOKey(SetPos), mkIOKey(SetPosition), mkIOKey(SetRec), mkIOKey(SetRecl),
- mkIOKey(SetRound), mkIOKey(SetSign), mkIOKey(SetStatus)>
+ mkIOKey(SetEncoding), mkIOKey(SetFile), mkIOKey(SetForm),
+ mkIOKey(SetLeadingZero), mkIOKey(SetPad), mkIOKey(SetPos),
+ mkIOKey(SetPosition), mkIOKey(SetRec), mkIOKey(SetRecl), mkIOKey(SetRound),
+ mkIOKey(SetSign), mkIOKey(SetStatus)>
newIOTable;
} // namespace Fortran::lower
@@ -1246,6 +1247,10 @@ mlir::Value genIOOption<Fortran::parser::ConnectSpec::CharExpr>(
case Fortran::parser::ConnectSpec::CharExpr::Kind::Form:
ioFunc = fir::runtime::getIORuntimeFunc<mkIOKey(SetForm)>(loc, builder);
break;
+ case Fortran::parser::ConnectSpec::CharExpr::Kind::Leading_Zero:
+ ioFunc =
+ fir::runtime::getIORuntimeFunc<mkIOKey(SetLeadingZero)>(loc, builder);
+ break;
case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad:
ioFunc = fir::runtime::getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
break;
@@ -1312,6 +1317,10 @@ mlir::Value genIOOption<Fortran::parser::IoControlSpec::CharExpr>(
case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim:
ioFunc = fir::runtime::getIORuntimeFunc<mkIOKey(SetDelim)>(loc, builder);
break;
+ case Fortran::parser::IoControlSpec::CharExpr::Kind::Leading_Zero:
+ ioFunc =
+ fir::runtime::getIORuntimeFunc<mkIOKey(SetLeadingZero)>(loc, builder);
+ break;
case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad:
ioFunc = fir::runtime::getIORuntimeFunc<mkIOKey(SetPad)>(loc, builder);
break;
diff --git a/flang/lib/Parser/io-parsers.cpp b/flang/lib/Parser/io-parsers.cpp
index c44f8ed9b548d..2d046f613b86d 100644
--- a/flang/lib/Parser/io-parsers.cpp
+++ b/flang/lib/Parser/io-parsers.cpp
@@ -96,6 +96,9 @@ TYPE_PARSER(first(construct<ConnectSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
scalarDefaultCharExpr)),
construct<ConnectSpec>("IOMSG =" >> msgVariable),
construct<ConnectSpec>("IOSTAT =" >> statVariable),
+ construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
+ "LEADING_ZERO =" >> pure(ConnectSpec::CharExpr::Kind::Leading_Zero),
+ scalarDefaultCharExpr)),
construct<ConnectSpec>(construct<ConnectSpec::Newunit>(
"NEWUNIT =" >> scalar(integer(variable)))),
construct<ConnectSpec>(construct<ConnectSpec::CharExpr>(
@@ -217,6 +220,10 @@ TYPE_PARSER(first(construct<IoControlSpec>("UNIT =" >> ioUnit),
construct<IoControlSpec>("ID =" >> idVariable),
construct<IoControlSpec>("IOMSG = " >> msgVariable),
construct<IoControlSpec>("IOSTAT = " >> statVariable),
+ construct<IoControlSpec>("LEADING_ZERO =" >>
+ construct<IoControlSpec::CharExpr>(
+ pure(IoControlSpec::CharExpr::Kind::Leading_Zero),
+ scalarDefaultCharExpr)),
construct<IoControlSpec>("PAD =" >>
construct<IoControlSpec::CharExpr>(
pure(IoControlSpec::CharExpr::Kind::Pad), scalarDefaultCharExpr)),
@@ -430,6 +437,10 @@ TYPE_PARSER(first(construct<InquireSpec>(maybe("UNIT ="_tok) >> fileUnitNumber),
construct<InquireSpec>("IOSTAT =" >>
construct<InquireSpec::IntVar>(pure(InquireSpec::IntVar::Kind::Iostat),
scalar(integer(variable)))),
+ construct<InquireSpec>(
+ "LEADING_ZERO =" >> construct<InquireSpec::CharVar>(
+ pure(InquireSpec::CharVar::Kind::Leading_Zero),
+ scalarDefaultCharVariable)),
construct<InquireSpec>("NAME =" >>
construct<InquireSpec::CharVar>(
pure(InquireSpec::CharVar::Kind::Name), scalarDefaultCharVariable)),
@@ -634,7 +645,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)
@@ -682,6 +694,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 9d01bb74d70d3..c31eac0b3ff68 100644
--- a/flang/lib/Parser/unparse.cpp
+++ b/flang/lib/Parser/unparse.cpp
@@ -1547,6 +1547,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/lib/Semantics/check-io.cpp b/flang/lib/Semantics/check-io.cpp
index 2d7e419e76ce0..46abd3d298d02 100644
--- a/flang/lib/Semantics/check-io.cpp
+++ b/flang/lib/Semantics/check-io.cpp
@@ -137,6 +137,9 @@ void IoChecker::Enter(const parser::ConnectSpec::CharExpr &spec) {
case ParseKind::Form:
specKind = IoSpecKind::Form;
break;
+ case ParseKind::Leading_Zero:
+ specKind = IoSpecKind::Leading_Zero;
+ break;
case ParseKind::Pad:
specKind = IoSpecKind::Pad;
break;
@@ -380,6 +383,9 @@ void IoChecker::Enter(const parser::InquireSpec::CharVar &spec) {
case ParseKind::Iomsg:
specKind = IoSpecKind::Iomsg;
break;
+ case ParseKind::Leading_Zero:
+ specKind = IoSpecKind::Leading_Zero;
+ break;
case ParseKind::Name:
specKind = IoSpecKind::Name;
break;
@@ -520,6 +526,9 @@ void IoChecker::Enter(const parser::IoControlSpec::CharExpr &spec) {
case ParseKind::Delim:
specKind = IoSpecKind::Delim;
break;
+ case ParseKind::Leading_Zero:
+ specKind = IoSpecKind::Leading_Zero;
+ break;
case ParseKind::Pad:
specKind = IoSpecKind::Pad;
break;
@@ -827,6 +836,7 @@ void IoChecker::Leave(const parser::ReadStmt &readStmt) {
LeaveReadWrite();
CheckForProhibitedSpecifier(IoSpecKind::Delim); // C1212
CheckForProhibitedSpecifier(IoSpecKind::Sign); // C1212
+ CheckForProhibitedSpecifier(IoSpecKind::Leading_Zero); // F'2023 C1212
CheckForProhibitedSpecifier(IoSpecKind::Rec, IoSpecKind::End); // C1220
if (specifierSet_.test(IoSpecKind::Size)) {
// F'2023 C1214 - allow with a warning
@@ -882,6 +892,8 @@ void IoChecker::Leave(const parser::WriteStmt &writeStmt) {
CheckForProhibitedSpecifier(IoSpecKind::Size); // C1213
CheckForRequiredSpecifier(
IoSpecKind::Sign, flags_.test(Flag::FmtOrNml), "FMT or NML"); // C1227
+ CheckForRequiredSpecifier(IoSpecKind::Leading_Zero,
+ flags_.test(Flag::FmtOrNml), "FMT or NML"); // F'2023 C1227
CheckForRequiredSpecifier(IoSpecKind::Delim,
flags_.test(Flag::StarFmt) || specifierSet_.test(IoSpecKind::Nml),
"FMT=* or NML"); // C1228
@@ -956,6 +968,7 @@ void IoChecker::CheckStringValue(IoSpecKind specKind, const std::string &value,
{IoSpecKind::Round,
{"COMPATIBLE", "DOWN", "NEAREST", "PROCESSOR_DEFINED", "UP", "ZERO"}},
{IoSpecKind::Sign, {"PLUS", "PROCESSOR_DEFINED", "SUPPRESS"}},
+ {IoSpecKind::Leading_Zero, {"PRINT", "PROCESSOR_DEFINED", "SUPPRESS"}},
{IoSpecKind::Status,
// Open values; Close values are {"DELETE", "KEEP"}.
{"NEW", "OLD", "REPLACE", "SCRATCH", "UNKNOWN"}},
diff --git a/flang/test/Semantics/io18.f90 b/flang/test/Semantics/io18.f90
new file mode 100644
index 0000000000000..686ba648ec3dd
--- /dev/null
+++ b/flang/test/Semantics/io18.f90
@@ -0,0 +1,126 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+
+! F202X leading-zero control edit descriptors: LZ, LZS, LZP
+
+ real :: x
+ character(20) :: lz_val
+
+ ! 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)
+
+ ! LEADING_ZERO= specifier tests
+
+ ! Valid LEADING_ZERO= on OPEN
+ open(10, file='test.dat', form='formatted', leading_zero='print')
+ open(10, file='test.dat', form='formatted', leading_zero='suppress')
+ open(10, file='test.dat', form='formatted', leading_zero='processor_defined')
+
+ ! Valid LEADING_ZERO= on WRITE
+ write(10, '(F10.3)', leading_zero='print') 0.5
+ write(10, '(F10.3)', leading_zero='suppress') 0.5
+
+ ! Error: LEADING_ZERO= on READ (prohibited, like SIGN=)
+ !ERROR: READ statement must not have a LEADING_ZERO specifier
+ read(10, '(F10.3)', leading_zero='print') x
+
+ ! Error: invalid LEADING_ZERO= value
+ !ERROR: Invalid LEADING_ZERO value 'bogus'
+ open(10, file='test.dat', form='formatted', leading_zero='bogus')
+
+ ! Valid LEADING_ZERO= on INQUIRE
+ inquire(10, leading_zero=lz_val)
+
+ close(10)
+end
diff --git a/flang/test/Transforms/set-runtime-call-attributes.fir b/flang/test/Transforms/set-runtime-call-attributes.fir
index bdc47c84f4d13..c3d6e4dd5797f 100644
--- a/flang/test/Transforms/set-runtime-call-attributes.fir
+++ b/flang/test/Transforms/set-runtime-call-attributes.fir
@@ -868,6 +868,17 @@ module {
%0 = fir.call @_FortranAioSetForm(%arg0, %arg1, %arg2) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
return %0 : i1
}
+// CHECK-LABEL: func.func @test__FortranAioSetLeadingZero(
+// CHECK-SAME: %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<i8>,
+// CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<i8>,
+// CHECK-SAME: %[[VAL_2:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: i64) -> i1 {
+// CHECK: %[[VAL_3:.*]] = fir.call @_FortranAioSetLeadingZero(%[[VAL_0]], %[[VAL_1]], %[[VAL_2]]) {fir.llvm_memory = #llvm.memory_effects<other = none, argMem = readwrite, inaccessibleMem = readwrite, errnoMem = none, targetMem0 = none, targetMem1 = none>, llvm.nocallback, llvm.nosync} : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+// CHECK: return %[[VAL_3]] : i1
+// CHECK: }
+ func.func @test__FortranAioSetLeadingZero(%arg0: !fir.ref<i8>, %arg1: !fir.ref<i8>, %arg2: i64) -> i1 {
+ %0 = fir.call @_FortranAioSetLeadingZero(%arg0, %arg1, %arg2) : (!fir.ref<i8>, !fir.ref<i8>, i64) -> i1
+ return %0 : i1
+ }
// CHECK-LABEL: func.func @test__FortranAioSetPad(
// CHECK-SAME: %[[VAL_0:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<i8>,
// CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref<i8>,
@@ -1028,6 +1039,7 @@ module {
func.func private @_FortranAioSetEncoding(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
func.func private @_FortranAioSetFile(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
func.func private @_FortranAioSetForm(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
+ func.func private @_FortranAioSetLeadingZero(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
func.func private @_FortranAioSetPad(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
func.func private @_FortranAioSetPos(!fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
func.func private @_FortranAioSetPosition(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
diff --git a/flang/test/Transforms/verify-known-runtime-functions.fir b/flang/test/Transforms/verify-known-runtime-functions.fir
index 902d701424f6f..e87fac5601c56 100644
--- a/flang/test/Transforms/verify-known-runtime-functions.fir
+++ b/flang/test/Transforms/verify-known-runtime-functions.fir
@@ -90,6 +90,7 @@
// CHECK-NEXT: func.func private @_FortranAioSetEncoding(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
// CHECK-NEXT: func.func private @_FortranAioSetFile(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
// CHECK-NEXT: func.func private @_FortranAioSetForm(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
+// CHECK-NEXT: func.func private @_FortranAioSetLeadingZero(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
// CHECK-NEXT: func.func private @_FortranAioSetPad(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
// CHECK-NEXT: func.func private @_FortranAioSetPos(!fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
// CHECK-NEXT: func.func private @_FortranAioSetPosition(!fir.ref<i8>, !fir.ref<i8>, i64) -> i1 attributes {fir.io, fir.runtime}
More information about the flang-commits
mailing list