diff --git a/flang/runtime/descriptor-io.h b/flang/runtime/descriptor-io.h --- a/flang/runtime/descriptor-io.h +++ b/flang/runtime/descriptor-io.h @@ -124,6 +124,7 @@ DataEdit rEdit, iEdit; rEdit.descriptor = DataEdit::ListDirectedRealPart; iEdit.descriptor = DataEdit::ListDirectedImaginaryPart; + rEdit.modes = iEdit.modes = io.mutableModes(); if (!RealOutputEditing{io, x[0]}.Edit(rEdit) || !RealOutputEditing{io, x[1]}.Edit(iEdit)) { return false; diff --git a/flang/runtime/edit-input.cpp b/flang/runtime/edit-input.cpp --- a/flang/runtime/edit-input.cpp +++ b/flang/runtime/edit-input.cpp @@ -48,6 +48,10 @@ return true; } +static inline char32_t GetDecimalPoint(const DataEdit &edit) { + return edit.modes.editingFlags & decimalComma ? char32_t{','} : char32_t{'.'}; +} + // Prepares input from a field, and consumes the sign, if any. // Returns true if there's a '-' sign. static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit, @@ -59,7 +63,7 @@ if (negative || *next == '+') { io.GotChar(); io.SkipSpaces(remaining); - next = io.NextInField(remaining); + next = io.NextInField(remaining, GetDecimalPoint(edit)); } } return negative; @@ -154,7 +158,7 @@ Put('0'); return got; } - char32_t decimal = edit.modes.editingFlags & decimalComma ? ',' : '.'; + char32_t decimal{GetDecimalPoint(edit)}; char32_t first{*next >= 'a' && *next <= 'z' ? *next + 'A' - 'a' : *next}; if (first == 'N' || first == 'I') { // NaN or infinity - convert to upper case @@ -179,7 +183,7 @@ Put('.'); // input field is normalized to a fraction auto start{got}; bool bzMode{(edit.modes.editingFlags & blankZero) != 0}; - for (; next; next = io.NextInField(remaining)) { + for (; next; next = io.NextInField(remaining, decimal)) { char32_t ch{*next}; if (ch == ' ' || ch == '\t') { if (bzMode) { diff --git a/flang/runtime/io-stmt.h b/flang/runtime/io-stmt.h --- a/flang/runtime/io-stmt.h +++ b/flang/runtime/io-stmt.h @@ -163,9 +163,14 @@ return std::nullopt; } - std::optional NextInField(std::optional &remaining) { + std::optional NextInField( + std::optional &remaining, char32_t decimal = '.') { if (!remaining) { // list-directed or NAMELIST: check for separators if (auto next{GetCurrentChar()}) { + if (*next == decimal) { // can be ',' + HandleRelativePosition(1); + return next; + } switch (*next) { case ' ': case '\t': diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp --- a/flang/runtime/io-stmt.cpp +++ b/flang/runtime/io-stmt.cpp @@ -580,13 +580,13 @@ DataEdit edit; edit.descriptor = DataEdit::ListDirected; edit.repeat = 1; // may be overridden below - edit.modes = connection.modes; + edit.modes = io.mutableModes(); if (hitSlash_) { // everything after '/' is nullified edit.descriptor = DataEdit::ListDirectedNullValue; return edit; } char32_t comma{','}; - if (io.mutableModes().editingFlags & decimalComma) { + if (edit.modes.editingFlags & decimalComma) { comma = ';'; } if (remaining_ > 0 && !realPart_) { // "r*c" repetition in progress @@ -619,6 +619,7 @@ // Consume comma & whitespace after previous item. // This includes the comma between real and imaginary components // in list-directed/NAMELIST complex input. + // (When DECIMAL='COMMA', the comma is actually a semicolon.) io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); } diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp --- a/flang/runtime/namelist.cpp +++ b/flang/runtime/namelist.cpp @@ -20,11 +20,17 @@ // NAMELIST input, plus a byte for NUL termination. static constexpr std::size_t nameBufferSize{201}; +static inline char32_t GetComma(IoStatementState &io) { + return io.mutableModes().editingFlags & decimalComma ? char32_t{';'} + : char32_t{','}; +} + bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) { IoStatementState &io{*cookie}; io.CheckFormattedStmtType("OutputNamelist"); ConnectionState &connection{io.GetConnectionState()}; connection.modes.inNamelist = true; + char comma{static_cast(GetComma(io))}; // Internal functions to advance records and convert case const auto EmitWithAdvance{[&](char ch) -> bool { return (!connection.NeedAdvance(1) || io.AdvanceRecord()) && @@ -51,7 +57,7 @@ for (std::size_t j{0}; j < group.items; ++j) { // [,]ITEM=... const NamelistGroup::Item &item{group.item[j]}; - if (!(EmitWithAdvance(j == 0 ? ' ' : ',') && EmitUpperCase(item.name) && + if (!(EmitWithAdvance(j == 0 ? ' ' : comma) && EmitUpperCase(item.name) && EmitWithAdvance('=') && descr::DescriptorIO(io, item.descriptor))) { return false; @@ -137,6 +143,7 @@ std::size_t contiguousStride{source.ElementBytes()}; bool ok{true}; std::optional ch{io.GetNextNonBlank()}; + char32_t comma{GetComma(io)}; for (; ch && *ch != ')'; ++j) { SubscriptValue dimLower{0}, dimUpper{0}, dimStride{0}; if (j < maxRank && j < source.rank()) { @@ -197,7 +204,7 @@ dimUpper = dimLower; dimStride = 0; } - if (ch && *ch == ',') { + if (ch && *ch == comma) { io.HandleRelativePosition(1); ch = io.GetNextNonBlank(); } @@ -358,6 +365,7 @@ std::optional next; char name[nameBufferSize]; RUNTIME_CHECK(handler, group.groupName != nullptr); + char32_t comma{GetComma(io)}; while (true) { next = io.GetNextNonBlank(); while (next && *next != '&') { @@ -391,7 +399,8 @@ } if (!GetLowerCaseName(io, name, sizeof name)) { handler.SignalError( - "NAMELIST input group '%s' was not terminated", group.groupName); + "NAMELIST input group '%s' was not terminated at '%c'", + group.groupName, static_cast(*next)); return false; } std::size_t itemIndex{0}; @@ -461,7 +470,7 @@ return false; } next = io.GetNextNonBlank(); - if (next && *next == ',') { + if (next && *next == comma) { io.HandleRelativePosition(1); } } diff --git a/flang/unittests/Runtime/Namelist.cpp b/flang/unittests/Runtime/Namelist.cpp --- a/flang/unittests/Runtime/Namelist.cpp +++ b/flang/unittests/Runtime/Namelist.cpp @@ -274,4 +274,35 @@ EXPECT_EQ(got, expect); } +// Tests DECIMAL=COMMA mode +TEST(NamelistTests, Comma) { + OwningPtr scDesc{ + MakeArray(sizeof(float))>( + std::vector{2}, std::vector>{{}, {}})}; + const NamelistGroup::Item items[]{{"z", *scDesc}}; + const NamelistGroup group{"nml", 1, items}; + static char t1[]{"&nml z=(-1,0;2,0);(-3,0;0,5)/"}; + StaticDescriptor<1, true> statDesc; + Descriptor &internalDesc{statDesc.descriptor()}; + internalDesc.Establish(TypeCode{CFI_type_char}, + /*elementBytes=*/std::strlen(t1), t1, 0, nullptr, CFI_attribute_pointer); + auto inCookie{IONAME(BeginInternalArrayListInput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDecimal)(inCookie, "COMMA", 5)); + ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(inCookie), IostatOk) + << "namelist input with skipping"; + char out[30]; + internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/sizeof out, + out, 0, nullptr, CFI_attribute_pointer); + auto outCookie{IONAME(BeginInternalArrayListOutput)( + internalDesc, nullptr, 0, __FILE__, __LINE__)}; + ASSERT_TRUE(IONAME(SetDecimal)(outCookie, "COMMA", 5)); + ASSERT_TRUE(IONAME(OutputNamelist)(outCookie, group)); + ASSERT_EQ(IONAME(EndIoStatement)(outCookie), IostatOk) << "namelist output"; + std::string got{out, sizeof out}; + static const std::string expect{"&NML Z= (-1,;2,) (-3,;,5)/ "}; + EXPECT_EQ(got, expect); +} + // TODO: Internal NAMELIST error tests