[flang] Support NAMELIST input of short arrays

[klausler]

Summary

NAMELIST array input does not need to fully define an array.
If another input item begins after at least one element,
it ends input into the array and the remaining items are
not modified.

The tricky part of supporting this feature is that it's not
always easy to determine whether the next non-blank thing in
the input is a value or the next item's name, esp. in the case
of logical data where T and F can be names. E.g.,

&group logicalArray = t f f t
    = 1 /

should read three elements into "logicalArray" and then read
an integer or real variable named "t".

So the I/O runtime has to do some look-ahead to determine whether
the next thing in the input is a name followed by '=', '(', or '%'.
Since the '=' may be on a later record, possibly with intervening
NAMELIST comments, the runtime has to support a general form of
saving and restoring its current position. The infrastructure
in the I/O runtime already has to support repositioning for
list-directed repetition, even on non-positionable input sources
like terminals and sockets; this patch adds an internal RAII API
to make it easier to save a position and then do arbitrary
look-ahead.

[vdonaldson]

If we ever consider the extension of allowing '.' as an alternative to '%' for component access, that might have consequences here.

flang/runtime/connection.h

struct ConnectionState : public ConnectionAttributes {
   // in order to keep a span of records in frame on a non-positionable file,
   // so that backspacing to the beginning of the repeated item doesn't require
   // repositioning the external storage medium when that's impossible.
   std::optional<std::int64_t> resumptionRecordNumber;
 
   // Mutable modes set at OPEN() that can be overridden in READ/WRITE & FORMAT
   MutableModes modes; // BLANK=, DECIMAL=, SIGN=, ROUND=, PAD=, DELIM=, kP
 };
+
+// Utility class for capturing and restoring a position in an input stream.
+class SavedPosition {
+public:
+  explicit SavedPosition(ConnectionState &c)
+      : connection_{c}, positionInRecord_{c.positionInRecord},
+        furthestPositionInRecord_{c.furthestPositionInRecord},
+        leftTabLimit_{c.leftTabLimit}, previousResumptionRecordNumber_{
+                                           c.resumptionRecordNumber} {
+    c.resumptionRecordNumber = c.currentRecordNumber;
+  }
+  ~SavedPosition() {
+    connection_.currentRecordNumber = *connection_.resumptionRecordNumber;
+    connection_.resumptionRecordNumber = previousResumptionRecordNumber_;
+    connection_.leftTabLimit = leftTabLimit_;
+    connection_.furthestPositionInRecord = furthestPositionInRecord_;
+    connection_.positionInRecord = positionInRecord_;
+  }
+
+private:
+  ConnectionState &connection_;
+  std::int64_t positionInRecord_;
+  std::int64_t furthestPositionInRecord_;
+  std::optional<std::int64_t> leftTabLimit_;
+  std::optional<std::int64_t> previousResumptionRecordNumber_;
+};
+
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_IO_CONNECTION_H_

flang/runtime/descriptor-io.h

 
 template <int KIND, Direction DIR>
 inline bool FormattedIntegerIO(
     IoStatementState &io, const Descriptor &descriptor) {
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+  bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     if (auto edit{io.GetNextDataEdit()}) {
       IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
       if constexpr (DIR == Direction::Output) {
         if (!EditIntegerOutput<KIND>(io, *edit, x)) {
           return false;
         }
       } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
-        if (!EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
-          return false;
+        if (EditIntegerInput(io, *edit, reinterpret_cast<void *>(&x), KIND)) {
+          anyInput = true;
+        } else {
+          return anyInput && edit->IsNamelist();
         }
       }
       if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
         io.GetIoErrorHandler().Crash(
             "FormattedIntegerIO: subscripts out of bounds");
       }
     } else {
       return false;
     }
   }
   return true;
 }
 
 template <int KIND, Direction DIR>
 inline bool FormattedRealIO(
     IoStatementState &io, const Descriptor &descriptor) {
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
+  bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     if (auto edit{io.GetNextDataEdit()}) {
       RawType &x{ExtractElement<RawType>(io, descriptor, subscripts)};
       if constexpr (DIR == Direction::Output) {
         if (!RealOutputEditing<KIND>{io, x}.Edit(*edit)) {
           return false;
         }
       } else if (edit->descriptor != DataEdit::ListDirectedNullValue) {
-        if (!EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
-          return false;
+        if (EditRealInput<KIND>(io, *edit, reinterpret_cast<void *>(&x))) {
+          anyInput = true;
+        } else {
+          return anyInput && edit->IsNamelist();
         }
       }
       if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
         io.GetIoErrorHandler().Crash(
             "FormattedRealIO: subscripts out of bounds");
       }
     } else {
       return false;
     }
   }
   return true;
 }
 
 template <int KIND, Direction DIR>
 inline bool FormattedComplexIO(
     IoStatementState &io, const Descriptor &descriptor) {
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   bool isListOutput{
       io.get_if<ListDirectedStatementState<Direction::Output>>() != nullptr};
   using RawType = typename RealOutputEditing<KIND>::BinaryFloatingPoint;
+  bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     RawType *x{&ExtractElement<RawType>(io, descriptor, subscripts)};
     if (isListOutput) {
       DataEdit rEdit, iEdit;
       rEdit.descriptor = DataEdit::ListDirectedRealPart;
       iEdit.descriptor = DataEdit::ListDirectedImaginaryPart;
       if (!RealOutputEditing<KIND>{io, x[0]}.Edit(rEdit) ||
           !RealOutputEditing<KIND>{io, x[1]}.Edit(iEdit)) {
         return false;
       }
     } else {
       for (int k{0}; k < 2; ++k, ++x) {
         auto edit{io.GetNextDataEdit()};
         if (!edit) {
           return false;
         } else if constexpr (DIR == Direction::Output) {
           if (!RealOutputEditing<KIND>{io, *x}.Edit(*edit)) {
             return false;
           }
         } else if (edit->descriptor == DataEdit::ListDirectedNullValue) {
           break;
-        } else if (!EditRealInput<KIND>(
+        } else if (EditRealInput<KIND>(
                        io, *edit, reinterpret_cast<void *>(x))) {
-          return false;
+          anyInput = true;
+        } else {
+          return anyInput && edit->IsNamelist();
         }
       }
     }
     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
       io.GetIoErrorHandler().Crash(
           "FormattedComplexIO: subscripts out of bounds");
     }
   }
   return true;
 }
 
 template <typename A, Direction DIR>
 inline bool FormattedCharacterIO(
     IoStatementState &io, const Descriptor &descriptor) {
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   std::size_t length{descriptor.ElementBytes() / sizeof(A)};
   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
+  bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     A *x{&ExtractElement<A>(io, descriptor, subscripts)};
     if (listOutput) {
       if (!ListDirectedDefaultCharacterOutput(io, *listOutput, x, length)) {
         return false;
       }
     } else if (auto edit{io.GetNextDataEdit()}) {
       if constexpr (DIR == Direction::Output) {
         if (!EditDefaultCharacterOutput(io, *edit, x, length)) {
           return false;
         }
       } else {
         if (edit->descriptor != DataEdit::ListDirectedNullValue) {
-          if (!EditDefaultCharacterInput(io, *edit, x, length)) {
-            return false;
+          if (EditDefaultCharacterInput(io, *edit, x, length)) {
+            anyInput = true;
+          } else {
+            return anyInput && edit->IsNamelist();
           }
         }
       }
     } else {
       return false;
     }
     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
       io.GetIoErrorHandler().Crash(
           "FormattedCharacterIO: subscripts out of bounds");
     }
   }
   return true;
 }
 
 template <int KIND, Direction DIR>
 inline bool FormattedLogicalIO(
     IoStatementState &io, const Descriptor &descriptor) {
   std::size_t numElements{descriptor.Elements()};
   SubscriptValue subscripts[maxRank];
   descriptor.GetLowerBounds(subscripts);
   auto *listOutput{io.get_if<ListDirectedStatementState<Direction::Output>>()};
   using IntType = CppTypeFor<TypeCategory::Integer, KIND>;
+  bool anyInput{false};
   for (std::size_t j{0}; j < numElements; ++j) {
     IntType &x{ExtractElement<IntType>(io, descriptor, subscripts)};
     if (listOutput) {
       if (!ListDirectedLogicalOutput(io, *listOutput, x != 0)) {
         return false;
       }
     } else if (auto edit{io.GetNextDataEdit()}) {
       if constexpr (DIR == Direction::Output) {
         if (!EditLogicalOutput(io, *edit, x != 0)) {
           return false;
         }
       } else {
         if (edit->descriptor != DataEdit::ListDirectedNullValue) {
           bool truth{};
           if (EditLogicalInput(io, *edit, truth)) {
             x = truth;
+            anyInput = true;
           } else {
-            return false;
+            return anyInput && edit->IsNamelist();
           }
         }
       }
     } else {
       return false;
     }
     if (!descriptor.IncrementSubscripts(subscripts) && j + 1 < numElements) {
       io.GetIoErrorHandler().Crash(

flang/runtime/edit-input.cpp

 //===-- runtime/edit-input.cpp --------------------------------------------===//
 //
 // Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.
 // See https://llvm.org/LICENSE.txt for license information.
 // SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception
 //
 //===----------------------------------------------------------------------===//
 
 #include "edit-input.h"
+#include "namelist.h"
 #include "flang/Common/real.h"
 #include "flang/Common/uint128.h"
 #include <algorithm>
 
 namespace Fortran::runtime::io {
 
 static bool EditBOZInput(IoStatementState &io, const DataEdit &edit, void *n,
     int base, int totalBitSize) {
static bool ScanNumericPrefix(IoStatementState &io, const DataEdit &edit,
   return negative;
 }
 
 bool EditIntegerInput(
     IoStatementState &io, const DataEdit &edit, void *n, int kind) {
   RUNTIME_CHECK(io.GetIoErrorHandler(), kind >= 1 && !(kind & (kind - 1)));
   switch (edit.descriptor) {
   case DataEdit::ListDirected:
+    if (IsNamelistName(io)) {
+      return false;
+    }
+    break;
   case 'G':
   case 'I':
     break;
   case 'B':
     return EditBOZInput(io, edit, n, 2, kind << 3);
   case 'O':
     return EditBOZInput(io, edit, n, 8, kind << 3);
   case 'Z':
bool EditCommonRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
   return true;
 }
 
 template <int KIND>
 bool EditRealInput(IoStatementState &io, const DataEdit &edit, void *n) {
   constexpr int binaryPrecision{common::PrecisionOfRealKind(KIND)};
   switch (edit.descriptor) {
   case DataEdit::ListDirected:
+    if (IsNamelistName(io)) {
+      return false;
+    }
+    return EditCommonRealInput<KIND>(io, edit, n);
   case DataEdit::ListDirectedRealPart:
   case DataEdit::ListDirectedImaginaryPart:
   case 'F':
   case 'E': // incl. EN, ES, & EX
   case 'D':
   case 'G':
     return EditCommonRealInput<KIND>(io, edit, n);
   case 'B':
default:
     return false;
   }
 }
 
 // 13.7.3 in Fortran 2018
 bool EditLogicalInput(IoStatementState &io, const DataEdit &edit, bool &x) {
   switch (edit.descriptor) {
   case DataEdit::ListDirected:
+    if (IsNamelistName(io)) {
+      return false;
+    }
+    break;
   case 'L':
   case 'G':
     break;
   default:
     io.GetIoErrorHandler().SignalError(IostatErrorInFormat,
         "Data edit descriptor '%c' may not be used for LOGICAL input",
         edit.descriptor);
     return false;

 
 static bool EditListDirectedDefaultCharacterInput(
     IoStatementState &io, char *x, std::size_t length) {
   auto ch{io.GetCurrentChar()};
   if (ch && (*ch == '\'' || *ch == '"')) {
     io.HandleRelativePosition(1);
     return EditDelimitedCharacterInput(io, x, length, *ch);
   }
+  if (IsNamelistName(io)) {
+    return false;
+  }
   // Undelimited list-directed character input: stop at a value separator
   // or the end of the current record.
   std::optional<int> remaining{length};
   for (std::optional<char32_t> next{io.NextInField(remaining)}; next;
        next = io.NextInField(remaining)) {
     switch (*next) {
     case ' ':
     case '\t':

flang/runtime/format.h

struct DataEdit {
   static constexpr char ListDirected{'g'}; // non-COMPLEX list-directed
   static constexpr char ListDirectedRealPart{'r'}; // emit "(r," or "(r;"
   static constexpr char ListDirectedImaginaryPart{'z'}; // emit "z)"
   static constexpr char ListDirectedNullValue{'n'}; // see 13.10.3.2
   constexpr bool IsListDirected() const {
     return descriptor == ListDirected || descriptor == ListDirectedRealPart ||
         descriptor == ListDirectedImaginaryPart;
   }
+  constexpr bool IsNamelist() const {
+    return IsListDirected() && modes.inNamelist;
+  }
 
   static constexpr char DefinedDerivedType{'d'}; // DT user-defined derived type
 
   char variation{'\0'}; // N, S, or X for EN, ES, EX
   std::optional<int> width; // the 'w' field; optional for A
   std::optional<int> digits; // the 'm' or 'd' field
   std::optional<int> expoDigits; // 'Ee' field
   MutableModes modes;

flang/runtime/io-stmt.h

class ListDirectedStatementState<Direction::Input>
     : public FormattedIoStatementState<Direction::Input> {
 public:
   // Skips value separators, handles repetition and null values.
   // Vacant when '/' appears; present with descriptor == ListDirectedNullValue
   // when a null value appears.
   std::optional<DataEdit> GetNextDataEdit(
       IoStatementState &, int maxRepeat = 1);
 
-  // Each NAMELIST input item is a distinct "list-directed"
-  // input statement.  This member function resets this state
-  // so that repetition and null values work correctly for each
-  // successive NAMELIST input item.
+  // Each NAMELIST input item is treated like a distinct list-directed
+  // input statement.  This member function resets some state so that
+  // repetition and null values work correctly for each successive
+  // NAMELIST input item.
   void ResetForNextNamelistItem() {
     remaining_ = 0;
     eatComma_ = false;
     realPart_ = imaginaryPart_ = false;
   }
 
 private:
   int remaining_{0}; // for "r*" repetition

flang/runtime/namelist.h

 
 #ifndef FORTRAN_RUNTIME_NAMELIST_H_
 #define FORTRAN_RUNTIME_NAMELIST_H_
 
 #include <cstddef>
 
 namespace Fortran::runtime {
 class Descriptor;
+class IoStatementState;
 } // namespace Fortran::runtime
 
 namespace Fortran::runtime::io {
 
 // A NAMELIST group is a named ordered collection of distinct variable names.
 // It is packaged by lowering into an instance of this class.
 // If all the items are variables with fixed addresses, the NAMELIST group
 // description can be in a read-only section.
 class NamelistGroup {
 public:
   struct Item {
     const char *name; // NUL-terminated lower-case
     const Descriptor &descriptor;
   };
   const char *groupName; // NUL-terminated lower-case
   std::size_t items;
   const Item *item; // in original declaration order
 };
+
+// Look ahead on input for an identifier followed by a '=', '(', or '%'
+// character; for use in disambiguating a name-like value (e.g. F or T) from a
+// NAMELIST group item name.  Always false when not reading a NAMELIST.
+bool IsNamelistName(IoStatementState &);
+
 } // namespace Fortran::runtime::io
 #endif // FORTRAN_RUNTIME_NAMELIST_H_

flang/runtime/namelist.cpp

while (true) {
     // Skip the '='
     next = io.GetNextNonBlank();
     if (!next || *next != '=') {
       handler.SignalError("No '=' found after item '%s' in NAMELIST group '%s'",
           name, group.groupName);
       return false;
     }
     io.HandleRelativePosition(1);
-    // Read the values into the descriptor
+    // Read the values into the descriptor.  An array can be short.
     listInput->ResetForNextNamelistItem();
     if (!descr::DescriptorIO<Direction::Input>(io, *useDescriptor)) {
       return false;
     }
     next = io.GetNextNonBlank();
     if (next && *next == ',') {
       io.HandleRelativePosition(1);
     }
   }
   if (!next || *next != '/') {
     handler.SignalError(
         "No '/' found after NAMELIST group '%s'", group.groupName);
     return false;
   }
   io.HandleRelativePosition(1);
   return true;
 }
 
+bool IsNamelistName(IoStatementState &io) {
+  if (io.get_if<ListDirectedStatementState<Direction::Input>>()) {
+    ConnectionState &connection{io.GetConnectionState()};
+    if (connection.modes.inNamelist) {
+      SavedPosition savedPosition{connection};
+      if (auto ch{io.GetNextNonBlank()}) {
+        if (IsLegalIdStart(*ch)) {
+          do {
+            io.HandleRelativePosition(1);
+            ch = io.GetCurrentChar();
+          } while (ch && IsLegalIdChar(*ch));
+          ch = io.GetNextNonBlank();
+          // TODO: how to deal with NaN(...) ambiguity?
+          return ch && (ch == '=' || ch == '(' || ch == '%');
+        }
+      }
+    }
+  }
+  return false;
+}
+
 } // namespace Fortran::runtime::io

flang/unittests/Runtime/Namelist.cpp

TEST(NamelistTests, Subscripts) {
   ASSERT_EQ(outStatus, 0)
       << "Failed namelist output subscripts rewrite, status "
       << static_cast<int>(outStatus);
   std::string got{out, sizeof out};
   static const std::string expect{"&JUSTA A= 0 2 0 0 0 1/                  "};
   EXPECT_EQ(got, expect);
 }
 
+TEST(NamelistTests, ShortArrayInput) {
+  OwningPtr<Descriptor> aDesc{
+      MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+          std::vector<int>{2}, std::vector<int>(2, -1))};
+  OwningPtr<Descriptor> bDesc{
+      MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
+          std::vector<int>{2}, std::vector<int>(2, -2))};
+  const NamelistGroup::Item items[]{{"a", *aDesc}, {"b", *bDesc}};
+  const NamelistGroup group{"nl", 2, items};
+  // Two 12-character lines of internal input
+  static char t1[]{"&nl a = 1 b "
+                   " = 2 /      "};
+  StaticDescriptor<1, true> statDesc;
+  Descriptor &internalDesc{statDesc.descriptor()};
+  SubscriptValue shape{2};
+  internalDesc.Establish(1, 12, t1, 1, &shape, CFI_attribute_pointer);
+  auto inCookie{IONAME(BeginInternalArrayListInput)(
+      internalDesc, nullptr, 0, __FILE__, __LINE__)};
+  ASSERT_TRUE(IONAME(InputNamelist)(inCookie, group));
+  auto inStatus{IONAME(EndIoStatement)(inCookie)};
+  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);
+}
+
 // TODO: Internal NAMELIST error tests