diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md --- a/flang/docs/Extensions.md +++ b/flang/docs/Extensions.md @@ -212,6 +212,9 @@ 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 --- a/flang/runtime/namelist.cpp +++ b/flang/runtime/namelist.cpp @@ -322,6 +322,29 @@ 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("InputNamelist"); @@ -330,26 +353,35 @@ IoErrorHandler &handler{io.GetIoErrorHandler()}; auto *listInput{io.get_if>()}; RUNTIME_CHECK(handler, listInput != nullptr); - // Check the group header + // Find this namelist group's header in the input io.BeginReadingRecord(); - std::optional 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 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 --- a/flang/unittests/Runtime/Namelist.cpp +++ b/flang/unittests/Runtime/Namelist.cpp @@ -189,7 +189,7 @@ EXPECT_EQ(*bDesc->ZeroBasedIndexedElement(1), -2); } -TEST(NamelistTypes, ScalarSubstring) { +TEST(NamelistTests, ScalarSubstring) { OwningPtr scDesc{MakeArray( std::vector{}, std::vector{"abcdefgh"}, 8)}; const NamelistGroup::Item items[]{{"a", *scDesc}}; @@ -217,7 +217,7 @@ EXPECT_EQ(got, expect); } -TEST(NamelistTypes, ArraySubstring) { +TEST(NamelistTests, ArraySubstring) { OwningPtr scDesc{ MakeArray(std::vector{2}, std::vector{"abcdefgh", "ijklmnop"}, 8)}; @@ -246,4 +246,32 @@ EXPECT_EQ(got, expect); } +TEST(NamelistTests, Skip) { + OwningPtr scDesc{ + MakeArray(sizeof(int))>( + std::vector{}, std::vector{-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