[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.
This commit is contained in:
laoshd
GitHub
parent
0afc30f8d5
commit
6e5e1c97e0
@ -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);
|
||||
|
||||
@ -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'
|
||||
|
||||
@ -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;
|
||||
}
|
||||
|
||||
@ -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>()};
|
||||
|
||||
@ -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"):
|
||||
|
||||
@ -22,6 +22,7 @@ add_flangrt_unittest(RuntimeTests
|
||||
Format.cpp
|
||||
InputExtensions.cpp
|
||||
Inquiry.cpp
|
||||
LeadingZeroTest.cpp
|
||||
ListInputTest.cpp
|
||||
LogicalFormatTest.cpp
|
||||
Matmul.cpp
|
||||
|
||||
379
flang-rt/unittests/Runtime/LeadingZeroTest.cpp
Normal file
379
flang-rt/unittests/Runtime/LeadingZeroTest.cpp
Normal file
@ -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 << "'";
|
||||
}
|
||||
@ -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:
|
||||
|
||||
@ -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 | |
|
||||
|
||||
@ -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 @@ private:
|
||||
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;
|
||||
|
||||
@ -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),
|
||||
|
||||
@ -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
|
||||
};
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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>(
|
||||
|
||||
@ -1547,6 +1547,9 @@ public:
|
||||
FMT(RP);
|
||||
FMT(DC);
|
||||
FMT(DP);
|
||||
FMT(LZ);
|
||||
FMT(LZS);
|
||||
FMT(LZP);
|
||||
#undef FMT
|
||||
case format::ControlEditDesc::Kind::Dollar:
|
||||
Put('$');
|
||||
|
||||
@ -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"}},
|
||||
|
||||
126
flang/test/Semantics/io18.f90
Normal file
126
flang/test/Semantics/io18.f90
Normal file
@ -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
|
||||
@ -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}
|
||||
|
||||
@ -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}
|
||||
|
||||
Loading…
x
Reference in New Issue
Block a user