[flang] Support DECIMAL='COMMA' mode in namelist I/O

[klausler]

Summary

DECIMAL='COMMA' mode affects item separators, real editing, and
complex editing.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/runtime/descriptor-io.h

inline bool FormattedComplexIO(
   using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
   bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
     if (isListOutput) {
       DataEdit rEdit, iEdit;
       rEdit.descriptor = DataEdit::ListDirectedRealPart;
       iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
+      rEdit.modes = iEdit.modes = io.mutableModes();
       if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
           !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {
         return false;
       }
     } else {
       for (int k{0}; k < 2; ++k, ++x) {
         auto edit{io.GetNextDataEdit()};
         if (!edit) {

flang/runtime/edit-input.cpp

for (; next; next = io.NextInField(remaining)) {
     value *= base;
     value += digit;
   }
   // TODO: check for overflow
   std::memcpy(n, &value, totalBitSize >> 3);
   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,
     std::optional<char32_t> &next, std::optional<int> &remaining) {
   next = io.PrepareInput(edit, remaining);
   bool negative{false};
   if (next) {
     negative = *next == '-';
     if (negative || *next == '+') {
       io.GotChar();
       io.SkipSpaces(remaining);
-      next = io.NextInField(remaining);
+      next = io.NextInField(remaining, GetDecimalPoint(edit));
     }
   }
   return negative;
 }
 
 bool EditIntegerInput(
     IoStatementState &io, const DataEdit &edit, void *n, int kind) {
   RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io,
   if (ScanNumericPrefix(io, edit, next, remaining)) {
     Put('-');
   }
   if (next.value_or(' ') == ' ') { // empty/blank field means zero
     remaining.reset();
     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
     // Subtle: a blank field of digits could be followed by 'E' or 'D',
     for (; next &&
          ((*next >= 'a' && *next <= 'z') || (*next >= 'A' && *next <= 'Z'));
          next = io.NextInField(remaining)) {
       if (*next >= 'a' && *next <= 'z') {
         Put(*next - 'a' + 'A');
       } else {
         Put(*next);
       }
     }
     if (next && *next == '(') { // NaN(...)
       while (next && *next != ')') {
         next = io.NextInField(remaining);
       }
     }
     exponent = 0;
   } else if (first == decimal || (first >= '0' && first <= '9') ||
       first == 'E' || first == 'D' || first == 'Q') {
     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) {
           ch = '0'; // BZ mode - treat blank as if it were zero
         } else {
           continue;
         }
       }

flang/runtime/io-stmt.h

while (!remaining || *remaining > 0) {
         }
       } else {
         break;
       }
     }
     return std::nullopt;
   }
 
-  std::optional<char32_t> NextInField(std::optional<int> &remaining) {
+  std::optional<char32_t> NextInField(
+      std::optional<int> &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':
         case ',':
         case ';':
         case '/':
         case '(':
         case ')':

flang/runtime/io-stmt.cpp

 std::optional<DataEdit>
 ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
     IoStatementState &io, int maxRepeat) {
   // N.B. list-directed transfers cannot be nonadvancing (C1221)
   ConnectionState &connection{io.GetConnectionState()};
   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
     RUNTIME_CHECK(io.GetIoErrorHandler(), repeatPosition_.has_value());
     repeatPosition_.reset(); // restores the saved position
     if (!imaginaryPart_) {
       edit.repeat = std::min<int>(remaining_, maxRepeat);
       auto ch{io.GetCurrentChar()};
if (imaginaryPart_) {
     imaginaryPart_ = true;
     edit.descriptor = DataEdit::ListDirectedImaginaryPart;
   }
   auto ch{io.GetNextNonBlank()};
   if (ch && *ch == comma && eatComma_) {
     // 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();
   }
   eatComma_ = true;
   if (!ch) {
     return std::nullopt;
   }
   if (*ch == '/') {

flang/runtime/namelist.cpp

 #include <limits>
 
 namespace Fortran::runtime::io {
 
 // Max size of a group, symbol or component identifier that can appear in
 // 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<Direction::Output>("OutputNamelist");
   ConnectionState &connection{io.GetConnectionState()};
   connection.modes.inNamelist = true;
+  char comma{static_cast<char>(GetComma(io))};
   // Internal functions to advance records and convert case
   const auto EmitWithAdvance{[&](char ch) -> bool {
     return (!connection.NeedAdvance(1) || io.AdvanceRecord()) &&
         io.Emit(&ch, 1);
   }};
   const auto EmitUpperCase{[&](const char *str) -> bool {
     if (connection.NeedAdvance(std::strlen(str)) &&
         !(io.AdvanceRecord() && io.Emit(" ", 1))) {
bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
   }};
   // &GROUP
   if (!(EmitWithAdvance('&') && EmitUpperCase(group.groupName))) {
     return false;
   }
   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<Direction::Output>(io, item.descriptor))) {
       return false;
     }
   }
   // terminal /
   return EmitWithAdvance('/');
 }
static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
   io.HandleRelativePosition(1); // skip '('
   // Allow for blanks in subscripts; they're nonstandard, but not
   // ambiguous within the parentheses.
   SubscriptValue lower[maxRank], upper[maxRank], stride[maxRank];
   int j{0};
   std::size_t contiguousStride{source.ElementBytes()};
   bool ok{true};
   std::optional<char32_t> 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()) {
       const Dimension &dim{source.GetDimension(j)};
       dimLower = dim.LowerBound();
       dimUpper = dim.UpperBound();
       dimStride =
           dim.ByteStride() / std::max<SubscriptValue>(contiguousStride, 1);
if (ch && *ch == ':') {
           dimStride = *str;
           ch = io.GetNextNonBlank();
         }
       }
     } else { // scalar
       dimUpper = dimLower;
       dimStride = 0;
     }
-    if (ch && *ch == ',') {
+    if (ch && *ch == comma) {
       io.HandleRelativePosition(1);
       ch = io.GetNextNonBlank();
     }
     if (ok) {
       lower[j] = dimLower;
       upper[j] = dimUpper;
       stride[j] = dimStride;
     }
bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   auto *listInput{io.get_if<ListDirectedStatementState<Direction::Input>>()};
   RUNTIME_CHECK(handler, listInput != nullptr);
   // Find this namelist group's header in the input
   io.BeginReadingRecord();
   std::optional<char32_t> next;
   char name[nameBufferSize];
   RUNTIME_CHECK(handler, group.groupName != nullptr);
+  char32_t comma{GetComma(io)};
   while (true) {
     next = io.GetNextNonBlank();
     while (next && *next != '&') {
       // Extension: comment lines without ! before namelist groups
       if (!io.AdvanceRecord()) {
         next.reset();
       } else {
         next = io.GetNextNonBlank();
bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   // Read the group's items
   while (true) {
     next = io.GetNextNonBlank();
     if (!next || *next == '/') {
       break;
     }
     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<char>(*next));
       return false;
     }
     std::size_t itemIndex{0};
     for (; itemIndex < group.items; ++itemIndex) {
       if (std::strcmp(name, group.item[itemIndex].name) == 0) {
         break;
       }
     }
while (true) {
     }
     io.HandleRelativePosition(1);
     // Read the values into the descriptor.  An array can be short.
     listInput->ResetForNextNamelistItem();
     if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
       return false;
     }
     next = io.GetNextNonBlank();
-    if (next && *next == ',') {
+    if (next && *next == comma) {
       io.HandleRelativePosition(1);
     }
   }
   if (!next || *next != '/') {
     handler.SignalError(
         "No '/' found after NAMELIST group '%s'", group.groupName);
     return false;
   }

flang/unittests/Runtime/Namelist.cpp

auto outCookie{IONAME(BeginInternalArrayListOutput)(
       internalDesc, nullptr, 0, __FILE__, __LINE__)};
   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 J= 123/        "};
   EXPECT_EQ(got, expect);
 }
 
+// Tests DECIMAL=COMMA mode
+TEST(NamelistTests, Comma) {
+  OwningPtr<Descriptor> scDesc{
+      MakeArray<TypeCategory::Complex, static_cast<int>(sizeof(float))>(
+          std::vector<int>{2}, std::vector<std::complex<float>>{{}, {}})};
+  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