[flang-commits] [flang] [flang][runtime] Extension: NAMELIST input may omit terminal '/' (PR #76476)

[Peter Klausler via flang-commits]

https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/76476

>From 91e46e44d3a2e0f58677227ae69689dce2729f91 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 27 Dec 2023 15:49:18 -0800
Subject: [PATCH] [flang][runtime] Extension: NAMELIST input may omit terminal
 '/'

... when it is followed eventually by the '&' that begins the next
NAMELIST input group.  This is a gfortran extension.  While here,
also support '$' as a substitute for '&' before a NAMELIST input
group name.

Fixes llvm-test-suite/Fortran/gfortran/regression/namelist_21.f90
and .../namelist_37.f90.
---
 flang/docs/Extensions.md     |  3 +++
 flang/runtime/edit-input.cpp |  9 +++++++--
 flang/runtime/io-stmt.cpp    |  2 ++
 flang/runtime/namelist.cpp   | 25 +++++++++++++++----------
 4 files changed, 27 insertions(+), 12 deletions(-)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6c6588025a392d..ab040b61703c8b 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -315,6 +315,9 @@ end
 * When a file included via an `INCLUDE` line or `#include` directive
   has a continuation marker at the end of its last line in free form,
   Fortran line continuation works.
+* 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 `$`.
 
 ### Extensions supported when enabled by options
 
diff --git a/flang/runtime/edit-input.cpp b/flang/runtime/edit-input.cpp
index c4fa186e289db2..71b40265a4dc57 100644
--- a/flang/runtime/edit-input.cpp
+++ b/flang/runtime/edit-input.cpp
@@ -21,7 +21,8 @@ namespace Fortran::runtime::io {
 static inline bool IsCharValueSeparator(const DataEdit &edit, char32_t ch) {
   char32_t comma{
       edit.modes.editingFlags & decimalComma ? char32_t{';'} : char32_t{','}};
-  return ch == ' ' || ch == '\t' || ch == '/' || ch == comma;
+  return ch == ' ' || ch == '\t' || ch == comma ||
+      (edit.IsNamelist() && (ch == '/' || ch == '&' || ch == '$'));
 }
 
 static bool CheckCompleteListDirectedField(
@@ -914,9 +915,13 @@ static bool EditListDirectedCharacterInput(
     switch (*next) {
     case ' ':
     case '\t':
-    case '/':
       isSep = true;
       break;
+    case '/':
+    case '&':
+    case '$':
+      isSep = edit.IsNamelist();
+      break;
     case ',':
       isSep = !(edit.modes.editingFlags & decimalComma);
       break;
diff --git a/flang/runtime/io-stmt.cpp b/flang/runtime/io-stmt.cpp
index 921c6e625edb5d..ffa8cd940c98f1 100644
--- a/flang/runtime/io-stmt.cpp
+++ b/flang/runtime/io-stmt.cpp
@@ -573,6 +573,8 @@ std::optional<char32_t> IoStatementState::NextInField(
         case ' ':
         case '\t':
         case '/':
+        case '&':
+        case '$':
         case '(':
         case ')':
         case '\'':
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index 61815a7cc8a403..d9908bf7089ac2 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -82,7 +82,7 @@ bool IONAME(OutputNamelist)(Cookie cookie, const NamelistGroup &group) {
 
 static constexpr bool IsLegalIdStart(char32_t ch) {
   return (ch >= 'A' && ch <= 'Z') || (ch >= 'a' && ch <= 'z') || ch == '_' ||
-      ch == '@' || ch == '$';
+      ch == '@';
 }
 
 static constexpr bool IsLegalIdChar(char32_t ch) {
@@ -378,12 +378,13 @@ static bool HandleComponent(IoStatementState &io, Descriptor &desc,
   return false;
 }
 
-// Advance to the terminal '/' of a namelist group.
+// Advance to the terminal '/' of a namelist group or leading '&'/'$'
+// of the next.
 static void SkipNamelistGroup(IoStatementState &io) {
   std::size_t byteCount{0};
   while (auto ch{io.GetNextNonBlank(byteCount)}) {
     io.HandleRelativePosition(byteCount);
-    if (*ch == '/') {
+    if (*ch == '/' || *ch == '&' || *ch == '$') {
       break;
     } else if (*ch == '\'' || *ch == '"') {
       // Skip quoted character literal
@@ -418,7 +419,7 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   std::size_t byteCount{0};
   while (true) {
     next = io.GetNextNonBlank(byteCount);
-    while (next && *next != '&') {
+    while (next && *next != '&' && *next != '$') {
       // Extension: comment lines without ! before namelist groups
       if (!io.AdvanceRecord()) {
         next.reset();
@@ -430,9 +431,10 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
       handler.SignalEnd();
       return false;
     }
-    if (*next != '&') {
+    if (*next != '&' && *next != '$') {
       handler.SignalError(
-          "NAMELIST input group does not begin with '&' (at '%lc')", *next);
+          "NAMELIST input group does not begin with '&' or '$' (at '%lc')",
+          *next);
       return false;
     }
     io.HandleRelativePosition(byteCount);
@@ -448,7 +450,7 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
   // Read the group's items
   while (true) {
     next = io.GetNextNonBlank(byteCount);
-    if (!next || *next == '/') {
+    if (!next || *next == '/' || *next == '&' || *next == '$') {
       break;
     }
     if (!GetLowerCaseName(io, name, sizeof name)) {
@@ -540,12 +542,15 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
       io.HandleRelativePosition(byteCount);
     }
   }
-  if (!next || *next != '/') {
+  if (next && *next == '/') {
+    io.HandleRelativePosition(byteCount);
+  } else if (*next && (*next == '&' || *next == '$')) {
+    // stop at beginning of next group
+  } else {
     handler.SignalError(
         "No '/' found after NAMELIST group '%s'", group.groupName);
     return false;
   }
-  io.HandleRelativePosition(byteCount);
   return true;
 }
 
@@ -565,7 +570,7 @@ bool IsNamelistNameOrSlash(IoStatementState &io) {
           // TODO: how to deal with NaN(...) ambiguity?
           return ch && (*ch == '=' || *ch == '(' || *ch == '%');
         } else {
-          return *ch == '/';
+          return *ch == '/' || *ch == '&' || *ch == '$';
         }
       }
     }