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

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

Differential Revision: https://reviews.llvm.org/D117906

flang/runtime/descriptor-io.h

@@ -124,6 +124,7 @@ inline bool FormattedComplexIO(
       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;

flang/runtime/edit-input.cpp

@@ -48,6 +48,10 @@ static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n,
   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 @@ static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit,
     if (negative || *next == '+') {
       io.GotChar();
       io.SkipSpaces(remaining);
-      next = io.NextInField(remaining);
+      next = io.NextInField(remaining, GetDecimalPoint(edit));
     }
   }
   return negative;
@@ -154,7 +158,7 @@ static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io,
     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 @@ static int ScanRealInput(char *buffer, int bufferSize, IoStatementState &io,
     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) {

flang/runtime/io-stmt.cpp

@@ -580,13 +580,13 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
   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 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
     // 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();
   }

flang/runtime/io-stmt.h

@@ -163,9 +163,14 @@ class IoStatementState {
     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':

flang/runtime/namelist.cpp

@@ -20,11 +20,17 @@ namespace Fortran::runtime::io {
 // 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()) &&
@@ -51,7 +57,7 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
   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;
@@ -137,6 +143,7 @@ static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
   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()) {
@@ -197,7 +204,7 @@ static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
       dimUpper = dimLower;
       dimStride = 0;
     }
-    if (ch && *ch == ',') {
+    if (ch && *ch == comma) {
       io.HandleRelativePosition(1);
       ch = io.GetNextNonBlank();
     }
@@ -358,6 +365,7 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   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 != '&') {
@@ -391,7 +399,8 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
     }
     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};
@@ -461,7 +470,7 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
       return false;
     }
     next = io.GetNextNonBlank();
-    if (next && *next == ',') {
+    if (next && *next == comma) {
       io.HandleRelativePosition(1);
     }
   }

flang/unittests/Runtime/Namelist.cpp

@@ -274,4 +274,35 @@ TEST(NamelistTests, Skip) {
   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