[flang] Support fixed-width input field truncation for LOGICAL (llvm#151203)

As a common extension, we support the truncation of fixed-width fields
for non-list-directed input editing when a separator character (',' or
';' depending on DECIMAL='POINT' or 'COMMA' resp.) appears in the field.
This isn't working for L input editing; fix.

(The bug reports a failure with DC mode, but it doesn't work with a
comma either.)

Fixes llvm#151178.

Author: klausler

flang-rt/include/flang-rt/runtime/format.h

@@ -36,6 +36,14 @@ enum EditingFlags {
 };
 
 struct MutableModes {
+  // Handle DC or DECIMAL='COMMA' and determine the active separator character
+  constexpr RT_API_ATTRS char32_t GetSeparatorChar() const {
+    return editingFlags & decimalComma ? char32_t{';'} : char32_t{','};
+  }
+  constexpr RT_API_ATTRS char32_t GetRadixPointChar() const {
+    return editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
+  }
+
   std::uint8_t editingFlags{0}; // BN, DP, SS
   enum decimal::FortranRounding round{
       executionEnvironment

flang-rt/lib/runtime/edit-input.cpp

@@ -19,14 +19,10 @@
 namespace Fortran::runtime::io {
 RT_OFFLOAD_API_GROUP_BEGIN
 
-// Handle DC or DECIMAL='COMMA' and determine the active separator character
-static inline RT_API_ATTRS char32_t GetSeparatorChar(const DataEdit &edit) {
-  return edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','};
-}
-
 static inline RT_API_ATTRS bool IsCharValueSeparator(
     const DataEdit &edit, char32_t ch) {
-  return ch == ' ' || ch == '\t' || ch == '/' || ch == GetSeparatorChar(edit) ||
+  return ch == ' ' || ch == '\t' || ch == '/' ||
+      ch == edit.modes.GetSeparatorChar() ||
       (edit.IsNamelist() && (ch == '&' || ch == '$'));
 }
 
@@ -68,7 +64,7 @@ static RT_API_ATTRS bool EditBOZInput(
   // Count significant digits after any leading white space & zeroes
   int digits{0};
   int significantBits{0};
-  const char32_t comma{GetSeparatorChar(edit)};
+  char32_t comma{edit.modes.GetSeparatorChar()};
   for (; next; next = io.NextInField(remaining, edit)) {
     char32_t ch{*next};
     if (ch == ' ' || ch == '\t') {
@@ -156,10 +152,6 @@ static RT_API_ATTRS bool EditBOZInput(
   return CheckCompleteListDirectedField(io, edit);
 }
 
-static inline RT_API_ATTRS char32_t GetRadixPointChar(const DataEdit &edit) {
-  return edit.modes.editingFlags & decimalComma ? char32_t{','} : char32_t{'.'};
-}
-
 // Prepares input from a field, and returns the sign, if any, else '\0'.
 static RT_API_ATTRS char ScanNumericPrefix(IoStatementState &io,
     const DataEdit &edit, Fortran::common::optional<char32_t> &next,
@@ -221,7 +213,7 @@ RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit,
   common::uint128_t value{0};
   bool any{!!sign};
   bool overflow{false};
-  const char32_t comma{GetSeparatorChar(edit)};
+  char32_t comma{edit.modes.GetSeparatorChar()};
   static constexpr auto maxu128{~common::uint128_t{0}};
   for (; next; next = io.NextInField(remaining, edit, &fastField)) {
     char32_t ch{*next};
@@ -238,7 +230,7 @@ RT_API_ATTRS bool EditIntegerInput(IoStatementState &io, const DataEdit &edit,
     } else if (ch == comma) {
       break; // end non-list-directed field early
     } else {
-      if (edit.modes.inNamelist && ch == GetRadixPointChar(edit)) {
+      if (edit.modes.inNamelist && ch == edit.modes.GetRadixPointChar()) {
         // Ignore any fractional part that might appear in NAMELIST integer
         // input, like a few other Fortran compilers do.
         // TODO: also process exponents?  Some compilers do, but they obviously
@@ -344,7 +336,7 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
   }
   bool bzMode{(edit.modes.editingFlags & blankZero) != 0};
   int exponent{0};
-  const char32_t comma{GetSeparatorChar(edit)};
+  char32_t comma{edit.modes.GetSeparatorChar()};
   if (!next || (!bzMode && *next == ' ') || *next == comma) {
     if (!edit.IsListDirected() && !io.GetConnectionState().IsAtEOF()) {
       // An empty/blank field means zero when not list-directed.
@@ -355,7 +347,7 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
     }
     return {got, exponent, false};
   }
-  char32_t radixPointChar{GetRadixPointChar(edit)};
+  char32_t radixPointChar{edit.modes.GetRadixPointChar()};
   char32_t first{*next >= 'a' && *next <= 'z' ? *next + 'A' - 'a' : *next};
   bool isHexadecimal{false};
   if (first == 'N' || first == 'I') {
@@ -518,7 +510,7 @@ static RT_API_ATTRS ScannedRealInput ScanRealInput(
     } else if (radixPointOffset) {
       exponent += *radixPointOffset;
     } else {
-      // When no redix point (or comma) appears in the value, the 'd'
+      // When no radix point (or comma) appears in the value, the 'd'
       // part of the edit descriptor must be interpreted as the number of
       // digits in the value to be interpreted as being to the *right* of
       // the assumed radix point (13.7.2.3.2)
@@ -959,10 +951,12 @@ RT_API_ATTRS bool EditLogicalInput(
         "Bad character '%lc' in LOGICAL input field", *next);
     return false;
   }
-  if (remaining) { // ignore the rest of a fixed-width field
-    io.HandleRelativePosition(*remaining);
-  } else if (edit.descriptor == DataEdit::ListDirected) {
-    while (io.NextInField(remaining, edit)) { // discard rest of field
+  if (remaining || edit.descriptor == DataEdit::ListDirected) {
+    // Ignore the rest of the input field; stop after separator when
+    // not list-directed.
+    char32_t comma{edit.modes.GetSeparatorChar()};
+    while (next && *next != comma) {
+      next = io.NextInField(remaining, edit);
     }
   }
   return CheckCompleteListDirectedField(io, edit);

flang-rt/lib/runtime/io-stmt.cpp

@@ -839,10 +839,7 @@ ListDirectedStatementState<Direction::Input>::GetNextDataEdit(
     edit.descriptor = DataEdit::ListDirectedNullValue;
     return edit;
   }
-  char32_t comma{','};
-  if (edit.modes.editingFlags & decimalComma) {
-    comma = ';';
-  }
+  const char32_t comma{edit.modes.GetSeparatorChar()};
   std::size_t byteCount{0};
   if (remaining_ > 0 && !realPart_) { // "r*c" repetition in progress
     RUNTIME_CHECK(io.GetIoErrorHandler(), repeatPosition_.has_value());

flang-rt/lib/runtime/namelist.cpp

@@ -27,8 +27,7 @@ RT_VAR_GROUP_END
 RT_OFFLOAD_API_GROUP_BEGIN
 
 static inline RT_API_ATTRS char32_t GetComma(IoStatementState &io) {
-  return io.mutableModes().editingFlags & decimalComma ? char32_t{';'}
-                                                       : char32_t{','};
+  return io.mutableModes().GetSeparatorChar();
 }
 
 bool IODEF(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {

flang-rt/unittests/Runtime/CMakeLists.txt

@@ -19,6 +19,7 @@ add_flangrt_unittest(RuntimeTests
   Derived.cpp
   ExternalIOTest.cpp
   Format.cpp
+  InputExtensions.cpp
   Inquiry.cpp
   ListInputTest.cpp
   LogicalFormatTest.cpp

flang-rt/unittests/Runtime/InputExtensions.cpp

@@ -0,0 +1,106 @@
+//===-- unittests/Runtime/InputExtensions.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
+//
+//===----------------------------------------------------------------------===//
+
+#include "CrashHandlerFixture.h"
+#include "flang-rt/runtime/descriptor.h"
+#include "flang/Runtime/io-api.h"
+#include <algorithm>
+#include <array>
+#include <cstring>
+#include <gtest/gtest.h>
+#include <tuple>
+
+using namespace Fortran::runtime;
+using namespace Fortran::runtime::io;
+
+struct InputExtensionTests : CrashHandlerFixture {};
+
+TEST(InputExtensionTests, SeparatorInField_F) {
+  static const struct {
+    int get;
+    const char *format, *data;
+    double expect[3];
+  } test[] = {
+      {2, "(2F6)", "1.25,3.75,", {1.25, 3.75}},
+      {2, "(2F6)", "1.25 ,3.75 ,", {1.25, 3.75}},
+      {2, "(DC,2F6)", "1,25;3,75;", {1.25, 3.75}},
+      {2, "(DC,2F6)", "1,25 ;3,75 ;", {1.25, 3.75}},
+  };
+  for (std::size_t j{0}; j < sizeof test / sizeof *test; ++j) {
+    auto cookie{IONAME(BeginInternalFormattedInput)(test[j].data,
+        std::strlen(test[j].data), test[j].format,
+        std::strlen(test[j].format))};
+    for (int k{0}; k < test[j].get; ++k) {
+      float got;
+      IONAME(InputReal32)(cookie, got);
+      ASSERT_EQ(got, test[j].expect[k])
+          << "expected " << test[j].expect[k] << ", got " << got;
+    }
+    auto status{IONAME(EndIoStatement)(cookie)};
+    ASSERT_EQ(status, 0) << "error status " << status << " on F test case "
+                         << j;
+  }
+}
+
+TEST(InputExtensionTests, SeparatorInField_I) {
+  static const struct {
+    int get;
+    const char *format, *data;
+    std::int64_t expect[3];
+  } test[] = {
+      {2, "(2I4)", "12,34,", {12, 34}},
+      {2, "(2I4)", "12 ,34 ,", {12, 34}},
+      {2, "(DC,2I4)", "12;34;", {12, 34}},
+      {2, "(DC,2I4)", "12 ;34 ;", {12, 34}},
+  };
+  for (std::size_t j{0}; j < sizeof test / sizeof *test; ++j) {
+    auto cookie{IONAME(BeginInternalFormattedInput)(test[j].data,
+        std::strlen(test[j].data), test[j].format,
+        std::strlen(test[j].format))};
+    for (int k{0}; k < test[j].get; ++k) {
+      std::int64_t got;
+      IONAME(InputInteger)(cookie, got);
+      ASSERT_EQ(got, test[j].expect[k])
+          << "expected " << test[j].expect[k] << ", got " << got;
+    }
+    auto status{IONAME(EndIoStatement)(cookie)};
+    ASSERT_EQ(status, 0) << "error status " << status << " on I test case "
+                         << j;
+  }
+}
+
+TEST(InputExtensionTests, SeparatorInField_L) {
+  static const struct {
+    int get;
+    const char *format, *data;
+    bool expect[3];
+  } test[] = {
+      {2, "(2L4)", ".T,F,", {true, false}},
+      {2, "(2L4)", ".F,T,", {false, true}},
+      {2, "(2L4)", ".T.,F,", {true, false}},
+      {2, "(2L4)", ".F.,T,", {false, true}},
+      {2, "(DC,2L4)", ".T;F,", {true, false}},
+      {2, "(DC,2L4)", ".F;T,", {false, true}},
+      {2, "(DC,2L4)", ".T.;F,", {true, false}},
+      {2, "(DC,2L4)", ".F.;T,", {false, true}},
+  };
+  for (std::size_t j{0}; j < sizeof test / sizeof *test; ++j) {
+    auto cookie{IONAME(BeginInternalFormattedInput)(test[j].data,
+        std::strlen(test[j].data), test[j].format,
+        std::strlen(test[j].format))};
+    for (int k{0}; k < test[j].get; ++k) {
+      bool got;
+      IONAME(InputLogical)(cookie, got);
+      ASSERT_EQ(got, test[j].expect[k])
+          << "expected " << test[j].expect[k] << ", got " << got;
+    }
+    auto status{IONAME(EndIoStatement)(cookie)};
+    ASSERT_EQ(status, 0) << "error status " << status << " on L test case "
+                         << j;
+  }
+}

flang/docs/Extensions.md

@@ -420,8 +420,9 @@ end
 * A `NAMELIST` input group may omit its trailing `/` character if
   it is followed by another `NAMELIST` input group.
 * A `NAMELIST` input group may begin with either `&` or `$`.
-* A comma in a fixed-width numeric input field terminates the
-  field rather than signaling an invalid character error.
+* A comma (or semicolon in `DECIMAL='COMMA'` or `DC` mode) in a
+  fixed-width numeric input field terminates the field rather than
+  signaling an invalid character error.
 * Arguments to the intrinsic functions `MAX` and `MIN` are converted
   when necessary to the type of the result.
   An `OPTIONAL`, `POINTER`, or `ALLOCATABLE` argument after