[flang-commits] [flang] d1123e3 - [flang] Extension: skip over NAMELIST groups

[Peter Klausler via flang-commits]

Author: Peter Klausler
Date: 2022-01-20T17:01:29-08:00
New Revision: d1123e36922d18e2b93b01e85ef706bc8f819fb5

URL: https://github.com/llvm/llvm-project/commit/d1123e36922d18e2b93b01e85ef706bc8f819fb5
DIFF: https://github.com/llvm/llvm-project/commit/d1123e36922d18e2b93b01e85ef706bc8f819fb5.diff

LOG: [flang] Extension: skip over NAMELIST groups

Implements a near-universal extension in which NAMELIST
input will skip over unrelated namelist groups in the
input stream until the group with the requested name appears.

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

Added: 
    

Modified: 
    flang/docs/Extensions.md
    flang/runtime/namelist.cpp
    flang/unittests/Runtime/Namelist.cpp

Removed: 
    


################################################################################
diff  --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index aa60800246ba3..270ec2dfd93c7 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -212,6 +212,9 @@ end
   This legacy extension supports pre-Fortran'77 usage in which
   variables initialized in DATA statements with Hollerith literals
   as modifiable formats.
+* At runtime, `NAMELIST` input will skip over `NAMELIST` groups
+  with other names, and will treat text before and between groups
+  as if they were comment lines, even if not begun with `!`.
 
 ### Extensions supported when enabled by options
 

diff  --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index 205212ccfb66e..fde828fddf443 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -322,6 +322,29 @@ static bool HandleComponent(IoStatementState &io, Descriptor &desc,
   return false;
 }
 
+// Advance to the terminal '/' of a namelist group.
+static void SkipNamelistGroup(IoStatementState &io) {
+  while (auto ch{io.GetNextNonBlank()}) {
+    io.HandleRelativePosition(1);
+    if (*ch == '/') {
+      break;
+    } else if (*ch == '\'' || *ch == '"') {
+      // Skip quoted character literal
+      char32_t quote{*ch};
+      while (true) {
+        if ((ch = io.GetCurrentChar())) {
+          io.HandleRelativePosition(1);
+          if (*ch == quote) {
+            break;
+          }
+        } else if (!io.AdvanceRecord()) {
+          return;
+        }
+      }
+    }
+  }
+}
+
 bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   IoStatementState &io{*cookie};
   io.CheckFormattedStmtType<Direction::Input>("InputNamelist");
@@ -330,26 +353,35 @@ 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);
-  // Check the group header
+  // Find this namelist group's header in the input
   io.BeginReadingRecord();
-  std::optional<char32_t> next{io.GetNextNonBlank()};
-  if (!next || *next != '&') {
-    handler.SignalError(
-        "NAMELIST input group does not begin with '&' (at '%lc')", *next);
-    return false;
-  }
-  io.HandleRelativePosition(1);
+  std::optional<char32_t> next;
   char name[nameBufferSize];
-  if (!GetLowerCaseName(io, name, sizeof name)) {
-    handler.SignalError("NAMELIST input group has no name");
-    return false;
-  }
   RUNTIME_CHECK(handler, group.groupName != nullptr);
-  if (std::strcmp(group.groupName, name) != 0) {
-    handler.SignalError(
-        "NAMELIST input group name '%s' is not the expected '%s'", name,
-        group.groupName);
-    return false;
+  while (true) {
+    next = io.GetNextNonBlank();
+    while (next && *next != '&') {
+      // Extension: comment lines without ! before namelist groups
+      if (!io.AdvanceRecord()) {
+        next.reset();
+      } else {
+        next = io.GetNextNonBlank();
+      }
+    }
+    if (!next || *next != '&') {
+      handler.SignalError(
+          "NAMELIST input group does not begin with '&' (at '%lc')", *next);
+      return false;
+    }
+    io.HandleRelativePosition(1);
+    if (!GetLowerCaseName(io, name, sizeof name)) {
+      handler.SignalError("NAMELIST input group has no name");
+      return false;
+    }
+    if (std::strcmp(group.groupName, name) == 0) {
+      break; // found it
+    }
+    SkipNamelistGroup(io);
   }
   // Read the group's items
   while (true) {

diff  --git a/flang/unittests/Runtime/Namelist.cpp b/flang/unittests/Runtime/Namelist.cpp
index f4f5a30e101eb..38305f729b145 100644
--- a/flang/unittests/Runtime/Namelist.cpp
+++ b/flang/unittests/Runtime/Namelist.cpp
@@ -189,7 +189,7 @@ TEST(NamelistTests, ShortArrayInput) {
   EXPECT_EQ(*bDesc->ZeroBasedIndexedElement<int>(1), -2);
 }
 
-TEST(NamelistTypes, ScalarSubstring) {
+TEST(NamelistTests, ScalarSubstring) {
   OwningPtr<Descriptor> scDesc{MakeArray<TypeCategory::Character, 1>(
       std::vector<int>{}, std::vector<std::string>{"abcdefgh"}, 8)};
   const NamelistGroup::Item items[]{{"a", *scDesc}};
@@ -217,7 +217,7 @@ TEST(NamelistTypes, ScalarSubstring) {
   EXPECT_EQ(got, expect);
 }
 
-TEST(NamelistTypes, ArraySubstring) {
+TEST(NamelistTests, ArraySubstring) {
   OwningPtr<Descriptor> scDesc{
       MakeArray<TypeCategory::Character, 1>(std::vector<int>{2},
           std::vector<std::string>{"abcdefgh", "ijklmnop"}, 8)};
@@ -246,4 +246,32 @@ TEST(NamelistTypes, ArraySubstring) {
   EXPECT_EQ(got, expect);
 }
 
+TEST(NamelistTests, Skip) {
+  OwningPtr<Descriptor> scDesc{
+      MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+          std::vector<int>{}, std::vector<int>{-1})};
+  const NamelistGroup::Item items[]{{"j", *scDesc}};
+  const NamelistGroup group{"nml", 1, items};
+  static char t1[]{"&skip a='str''ing'/&nml j=123/"};
+  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 input with skipping";
+  char out[20];
+  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