[flang-commits] [flang] [flang][runtime] Accept some real input for integer NAMELIST (PR #108268)

[Peter Klausler via flang-commits]

https://github.com/klausler created https://github.com/llvm/llvm-project/pull/108268

A few other Fortran compilers silently accept real values for integer variables in NAMELIST input.  Handling an exponent would be difficult, but it's easy to skip and ignore a fractional part when one is present.

>From f78379f008b70a2c274ca1901e3362d9df168bd4 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 11 Sep 2024 11:24:50 -0700
Subject: [PATCH] [flang][runtime] Accept some real input for integer NAMELIST

A few other Fortran compilers silently accept real values for
integer variables in NAMELIST input.  Handling an exponent
would be difficult, but it's easy to skip and ignore a fractional
part when one is present.
---
 flang/runtime/edit-input.cpp         | 24 +++++++++++++++++++++--
 flang/unittests/Runtime/Namelist.cpp | 29 ++++++++++++++++++++++++++++
 2 files changed, 51 insertions(+), 2 deletions(-)

diff --git a/flang/runtime/edit-input.cpp b/flang/runtime/edit-input.cpp
index 61b070bde80e6f..2cee35e23f31a3 100644
--- a/flang/runtime/edit-input.cpp
+++ b/flang/runtime/edit-input.cpp
@@ -54,6 +54,10 @@ static RT_API_ATTRS bool CheckCompleteListDirectedField(
   }
 }
 
+static inline RT_API_ATTRS char32_t GetSeparatorChar(const DataEdit &edit) {
+  return edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','};
+}
+
 template <int LOG2_BASE>
 static RT_API_ATTRS bool EditBOZInput(
     IoStatementState &io, const DataEdit &edit, void *n, std::size_t bytes) {
@@ -70,6 +74,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)};
   for (; next; next = io.NextInField(remaining, edit)) {
     char32_t ch{*next};
     if (ch == ' ' || ch == '\t') {
@@ -84,7 +89,7 @@ static RT_API_ATTRS bool EditBOZInput(
     } else if (LOG2_BASE >= 4 && ch >= '8' && ch <= '9') {
     } else if (LOG2_BASE >= 4 && ch >= 'A' && ch <= 'F') {
     } else if (LOG2_BASE >= 4 && ch >= 'a' && ch <= 'f') {
-    } else if (ch == ',') {
+    } else if (ch == comma) {
       break; // end non-list-directed field early
     } else {
       io.GetIoErrorHandler().SignalError(
@@ -209,6 +214,7 @@ RT_API_ATTRS bool EditIntegerInput(
   common::UnsignedInt128 value{0};
   bool any{!!sign};
   bool overflow{false};
+  const char32_t comma{GetSeparatorChar(edit)};
   for (; next; next = io.NextInField(remaining, edit)) {
     char32_t ch{*next};
     if (ch == ' ' || ch == '\t') {
@@ -221,9 +227,23 @@ RT_API_ATTRS bool EditIntegerInput(
     int digit{0};
     if (ch >= '0' && ch <= '9') {
       digit = ch - '0';
-    } else if (ch == ',') {
+    } else if (ch == comma) {
       break; // end non-list-directed field early
     } else {
+      if (edit.modes.inNamelist && ch == GetRadixPointChar(edit)) {
+        // 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
+        // can't just be ignored.
+        while ((next = io.NextInField(remaining, edit))) {
+          if (*next < '0' || *next > '9') {
+            break;
+          }
+        }
+        if (!next || *next == comma) {
+          break;
+        }
+      }
       io.GetIoErrorHandler().SignalError(
           "Bad character '%lc' in INTEGER input field", ch);
       return false;
diff --git a/flang/unittests/Runtime/Namelist.cpp b/flang/unittests/Runtime/Namelist.cpp
index f95c5d2e553aa7..9037fa15a97cb3 100644
--- a/flang/unittests/Runtime/Namelist.cpp
+++ b/flang/unittests/Runtime/Namelist.cpp
@@ -305,4 +305,33 @@ TEST(NamelistTests, Comma) {
   EXPECT_EQ(got, expect);
 }
 
+// Tests REAL-looking input to integers
+TEST(NamelistTests, RealValueForInt) {
+  OwningPtr<Descriptor> scDesc{
+      MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+          std::vector<int>{}, std::vector<int>{{}})};
+  const NamelistGroup::Item items[]{{"j", *scDesc}};
+  const NamelistGroup group{"nml", 1, items};
+  static char t1[]{"&nml j=123.456/"};
+  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(InputNamelist)(inCookie, group));
+  ASSERT_EQ(IONAME(EndIoStatement)(inCookie), IostatOk)
+      << "namelist real input for integer";
+  char out[16];
+  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(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);
+}
+
 // TODO: Internal NAMELIST error tests