[flang] Extension: skip over NAMELIST groups

[klausler]

Summary

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.

flang/docs/Extensions.md

* A `POINTER` component's type need not be a sequence type when
   the component appears in a derived type with `SEQUENCE`.
   (This case should probably be an exception to constraint C740 in
   the standard.)
 * Format expressions that have type but are not character and not
   integer scalars are accepted so long as they are simply contiguous.
   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
 
 * C-style backslash escape sequences in quoted CHARACTER literals
   (but not Hollerith) [-fbackslash]
 * Logical abbreviations `.T.`, `.F.`, `.N.`, `.A.`, `.O.`, and `.X.`
   [-flogical-abbreviations]
 * `.XOR.` as a synonym for `.NEQV.` [-fxor-operator]

flang/runtime/namelist.cpp

static bool HandleComponent(IoStatementState &io, Descriptor &desc,
   } else {
     handler.SignalError("NAMELIST component reference of input group item %s "
                         "has no name after '%'",
         name);
   }
   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");
   ConnectionState &connection{io.GetConnectionState()};
   connection.modes.inNamelist = true;
   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()};
+  std::optional<char32_t> next;
+  char name[nameBufferSize];
+  RUNTIME_CHECK(handler, group.groupName != nullptr);
+  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);
-  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;
+    if (std::strcmp(group.groupName, name) == 0) {
+      break; // found it
+    }
+    SkipNamelistGroup(io);
   }
   // Read the group's items
   while (true) {
     next = io.GetNextNonBlank();
     if (!next || *next == '/') {
       break;
     }
     if (!GetLowerCaseName(io, name, sizeof name)) {

flang/unittests/Runtime/Namelist.cpp

TEST(NamelistTests, ShortArrayInput) {
   ASSERT_EQ(inStatus, 0) << "Failed namelist input subscripts, status "
                          << static_cast<int>(inStatus);
   EXPECT_EQ(*aDesc->ZeroBasedIndexedElement<int>(0), 1);
   EXPECT_EQ(*aDesc->ZeroBasedIndexedElement<int>(1), -1);
   EXPECT_EQ(*bDesc->ZeroBasedIndexedElement<int>(0), 2);
   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}};
   const NamelistGroup group{"justa", 1, items};
   static char t1[]{"&justa A(2:5)='BCDE'/"};
   StaticDescriptor<1, true> statDesc;
   Descriptor &internalDesc{statDesc.descriptor()};
   internalDesc.Establish(TypeCode{CFI_type_char},
TEST(NamelistTests, ScalarSubstring) {
   ASSERT_TRUE(IONAME(SetDelim)(outCookie, "apostrophe", 10));
   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{"&JUSTA A= 'aBCDEfgh'/           "};
   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)};
   const NamelistGroup::Item items[]{{"a", *scDesc}};
   const NamelistGroup group{"justa", 1, items};
   static char t1[]{"&justa A(:)(2:+5)='BCDE' 'JKLM'/"};
   StaticDescriptor<1, true> statDesc;
   Descriptor &internalDesc{statDesc.descriptor()};
TEST(NamelistTests, ArraySubstring) {
   ASSERT_TRUE(IONAME(SetDelim)(outCookie, "apostrophe", 10));
   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{"&JUSTA A= 'aBCDEfgh' 'iJKLMnop'/        "};
   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