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 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::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::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::CueUpNextDataEdit( repeat = GetIntField(context); } HandleControl(context, static_cast(ch), static_cast(next), - repeat ? *repeat : 1); + static_cast(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::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::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::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()}) { + 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(length), keyword); + return false; + } +} + bool IODEF(SetAccess)(Cookie cookie, const char *keyword, std::size_t length) { IoStatementState &io{*cookie}; auto *open{io.get_if()}; 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 +#include +#include +#include +#include +#include + +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 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 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 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 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 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 d1940a1858db1..c510b03b1820c 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 f57956cd6d6b8..06a2fce637167 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 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 void FormatValidator::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 bool FormatValidator::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 bool FormatValidator::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 bool FormatValidator::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 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 t; }; @@ -2837,6 +2841,7 @@ WRAPPER_CLASS(FlushStmt, std::list); // 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 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( case Fortran::parser::ConnectSpec::CharExpr::Kind::Form: ioFunc = fir::runtime::getIORuntimeFunc(loc, builder); break; + case Fortran::parser::ConnectSpec::CharExpr::Kind::Leading_Zero: + ioFunc = + fir::runtime::getIORuntimeFunc(loc, builder); + break; case Fortran::parser::ConnectSpec::CharExpr::Kind::Pad: ioFunc = fir::runtime::getIORuntimeFunc(loc, builder); break; @@ -1312,6 +1317,10 @@ mlir::Value genIOOption( case Fortran::parser::IoControlSpec::CharExpr::Kind::Delim: ioFunc = fir::runtime::getIORuntimeFunc(loc, builder); break; + case Fortran::parser::IoControlSpec::CharExpr::Kind::Leading_Zero: + ioFunc = + fir::runtime::getIORuntimeFunc(loc, builder); + break; case Fortran::parser::IoControlSpec::CharExpr::Kind::Pad: ioFunc = fir::runtime::getIORuntimeFunc(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(maybe("UNIT ="_tok) >> fileUnitNumber), scalarDefaultCharExpr)), construct("IOMSG =" >> msgVariable), construct("IOSTAT =" >> statVariable), + construct(construct( + "LEADING_ZERO =" >> pure(ConnectSpec::CharExpr::Kind::Leading_Zero), + scalarDefaultCharExpr)), construct(construct( "NEWUNIT =" >> scalar(integer(variable)))), construct(construct( @@ -217,6 +220,10 @@ TYPE_PARSER(first(construct("UNIT =" >> ioUnit), construct("ID =" >> idVariable), construct("IOMSG = " >> msgVariable), construct("IOSTAT = " >> statVariable), + construct("LEADING_ZERO =" >> + construct( + pure(IoControlSpec::CharExpr::Kind::Leading_Zero), + scalarDefaultCharExpr)), construct("PAD =" >> construct( pure(IoControlSpec::CharExpr::Kind::Pad), scalarDefaultCharExpr)), @@ -430,6 +437,10 @@ TYPE_PARSER(first(construct(maybe("UNIT ="_tok) >> fileUnitNumber), construct("IOSTAT =" >> construct(pure(InquireSpec::IntVar::Kind::Iostat), scalar(integer(variable)))), + construct( + "LEADING_ZERO =" >> construct( + pure(InquireSpec::CharVar::Kind::Leading_Zero), + scalarDefaultCharVariable)), construct("NAME =" >> construct( pure(InquireSpec::CharVar::Kind::Name), scalarDefaultCharVariable)), @@ -634,7 +645,8 @@ TYPE_PARSER(construct( "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( pure(format::ControlEditDesc::Kind::BN)) || "Z " >> construct( pure(format::ControlEditDesc::Kind::BZ))) || + "L " >> ("Z " >> ("S " >> construct( + pure(format::ControlEditDesc::Kind::LZS)) || + "P " >> construct(pure( + format::ControlEditDesc::Kind::LZP)) || + construct( + pure(format::ControlEditDesc::Kind::LZ)))) || "R " >> ("U " >> construct( pure(format::ControlEditDesc::Kind::RU)) || "D " >> construct( 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, !fir.ref, 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, +// CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref, +// 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, llvm.nocallback, llvm.nosync} : (!fir.ref, !fir.ref, i64) -> i1 +// CHECK: return %[[VAL_3]] : i1 +// CHECK: } + func.func @test__FortranAioSetLeadingZero(%arg0: !fir.ref, %arg1: !fir.ref, %arg2: i64) -> i1 { + %0 = fir.call @_FortranAioSetLeadingZero(%arg0, %arg1, %arg2) : (!fir.ref, !fir.ref, 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, // CHECK-SAME: %[[VAL_1:[0-9]+|[a-zA-Z$._-][a-zA-Z0-9$._-]*]]: !fir.ref, @@ -1028,6 +1039,7 @@ module { func.func private @_FortranAioSetEncoding(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} func.func private @_FortranAioSetFile(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} func.func private @_FortranAioSetForm(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} + func.func private @_FortranAioSetLeadingZero(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} func.func private @_FortranAioSetPad(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} func.func private @_FortranAioSetPos(!fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} func.func private @_FortranAioSetPosition(!fir.ref, !fir.ref, 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, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} // CHECK-NEXT: func.func private @_FortranAioSetFile(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} // CHECK-NEXT: func.func private @_FortranAioSetForm(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} +// CHECK-NEXT: func.func private @_FortranAioSetLeadingZero(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} // CHECK-NEXT: func.func private @_FortranAioSetPad(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} // CHECK-NEXT: func.func private @_FortranAioSetPos(!fir.ref, i64) -> i1 attributes {fir.io, fir.runtime} // CHECK-NEXT: func.func private @_FortranAioSetPosition(!fir.ref, !fir.ref, i64) -> i1 attributes {fir.io, fir.runtime}