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

[Peter Klausler via flang-commits]

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

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.

>From b672d5300917319b479cd3af3a5bc9dca5e233de 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.
---
 flang/docs/Extensions.md   |  4 ++++
 flang/runtime/namelist.cpp | 44 +++++++++++++++++++++++++++-----------
 2 files changed, 35 insertions(+), 13 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..f2c0a0e6215708 100644
--- a/flang/runtime/namelist.cpp
+++ b/flang/runtime/namelist.cpp
@@ -229,22 +229,40 @@ static bool HandleSubscripts(IoStatementState &io, Descriptor &desc,
       stride[j] = dimStride;
     }
   }
-  if (ok) {
-    if (ch && *ch == ')') {
-      io.HandleRelativePosition(byteCount);
-      if (desc.EstablishPointerSection(source, lower, upper, stride)) {
-        return true;
-      } else {
-        handler.SignalError(
-            "Bad subscripts for NAMELIST input group item '%s'", name);
-      }
-    } else {
+  if (!ok) {
+    return false;
+  } else if (ch && *ch == ')') {
+    io.HandleRelativePosition(byteCount);
+    if (!desc.EstablishPointerSection(source, lower, upper, stride)) {
       handler.SignalError(
-          "Bad subscripts (missing ')') for NAMELIST input group item '%s'",
-          name);
+          "Bad subscripts for NAMELIST input group item '%s'", name);
+      return false;
     }
+  } else {
+    handler.SignalError(
+        "Bad subscripts (missing ')') for NAMELIST input group item '%s'",
+        name);
+    return false;
   }
-  return false;
+  // 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);
+    }
+  }
+  return true;
 }
 
 static bool HandleSubstring(