[flang-commits] [flang] [flang][runtime] NAMELIST input into storage sequence (PR #76584)

[Peter Klausler via flang-commits]

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

>From 0dc260365ffe9ec1a836d0a38b1a57c6122024a8 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Fri, 29 Dec 2023 11:31:30 -0800
Subject: [PATCH] [flang][runtime] NAMELIST input into storage sequence

Nearly every Fortran compiler supports the extension of
NAMELIST input into a storage sequence identified by its
initial scalar array element.  For example,
  &GROUP A(1) = 1. 2. 3. /
should be processed as if the input had been
  &GROUP A(1:) = 1. 2. 3. /

Fixes llvm-test-suite/Fortran/gfortran/regression/namelist_24.f90
and .../namelist_61.f90.
---
 flang/docs/Extensions.md   |  4 ++++
 flang/runtime/namelist.cpp | 38 ++++++++++++++++++++++++++++++++++----
 2 files changed, 38 insertions(+), 4 deletions(-)

diff --git a/flang/docs/Extensions.md b/flang/docs/Extensions.md
index 6c6588025a392d..7876a9ba80cbbe 100644
--- a/flang/docs/Extensions.md
+++ b/flang/docs/Extensions.md
@@ -654,3 +654,7 @@ end
   but every Fortran compiler allows the encoding to be changed on an
   open unit.
 
+* A `NAMELIST` input item that references a scalar element of a vector
+  or contiguous array can be used as the initial element of a storage
+  sequence.  For example, "&GRP A(1)=1. 2. 3./" is treated as if had been
+  "&GRP A(1:)=1. 2. 3./".
diff --git a/flang/runtime/namelist.cpp b/flang/runtime/namelist.cpp
index 61815a7cc8a403..721f4805dd0e18 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -247,6 +247,28 @@ static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
   return false;
 }
 
+static void StorageSequenceExtension(
+    Descriptor &desc, const Descriptor &source) {
+  // Support the near-universal extension of NAMELIST input into a
+  // designatable storage sequence identified by its initial scalar array
+  // element.  For example, treat "A(1) = 1. 2. 3." as if it had been
+  // "A(1:) = 1. 2. 3.".
+  if (desc.rank() == 0 && (source.rank() == 1 || source.IsContiguous())) {
+    if (auto stride{source.rank() == 1
+                ? source.GetDimension(0).ByteStride()
+                : static_cast<SubscriptValue>(source.ElementBytes())};
+        stride != 0) {
+      desc.raw().attribute = CFI_attribute_pointer;
+      desc.raw().rank = 1;
+      desc.GetDimension(0)
+          .SetBounds(1,
+              source.Elements() -
+                  ((source.OffsetElement() - desc.OffsetElement()) / stride))
+          .SetByteStride(stride);
+    }
+  }
+}
+
 static bool HandleSubstring(
     IoStatementState &io, Descriptor &desc, const char *name) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
@@ -478,10 +500,14 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
     bool hadSubscripts{false};
     bool hadSubstring{false};
     if (next && (*next == '(' || *next == '%')) {
+      const Descriptor *lastSubscriptBase{nullptr};
+      Descriptor *lastSubscriptDescriptor{nullptr};
       do {
         Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()};
         whichStaticDesc ^= 1;
         io.HandleRelativePosition(byteCount); // skip over '(' or '%'
+        lastSubscriptDescriptor = nullptr;
+        lastSubscriptBase = nullptr;
         if (*next == '(') {
           if (!hadSubstring && (hadSubscripts || useDescriptor->rank() == 0)) {
             mutableDescriptor = *useDescriptor;
@@ -495,11 +521,12 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
                                 "NAMELIST group '%s'",
                 name, group.groupName);
             return false;
+          } else if (HandleSubscripts(
+                         io, mutableDescriptor, *useDescriptor, name)) {
+            lastSubscriptBase = useDescriptor;
+            lastSubscriptDescriptor = &mutableDescriptor;
           } else {
-            if (!HandleSubscripts(
-                    io, mutableDescriptor, *useDescriptor, name)) {
-              return false;
-            }
+            return false;
           }
           hadSubscripts = true;
         } else {
@@ -512,6 +539,9 @@ bool IONAME(InputNamelist)(Cookie cookie, const NamelistGroup &group) {
         useDescriptor = &mutableDescriptor;
         next = io.GetCurrentChar(byteCount);
       } while (next && (*next == '(' || *next == '%'));
+      if (lastSubscriptDescriptor) {
+        StorageSequenceExtension(*lastSubscriptDescriptor, *lastSubscriptBase);
+      }
     }
     // Skip the '='
     next = io.GetNextNonBlank(byteCount);