[flang] Support substring references in NAMELIST input

[klausler]

Summary

Implements substring references into potentially partial CHARACTER
scalars and array elements in NAMELIST input.

flang/runtime/namelist.cpp

if (ch && *ch == ')') {
       handler.SignalError(
           "Bad subscripts (missing ')') for NAMELIST input group item '%s'",
           name);
     }
   }
   return false;
 }
 
+static bool HandleSubstring(
+    IoStatementState &io, Descriptor &desc, const char *name) {
+  IoErrorHandler &handler{io.GetIoErrorHandler()};
+  auto pair{desc.type().GetCategoryAndKind()};
+  if (!pair || pair->first != TypeCategory::Character) {
+    handler.SignalError("Substring reference to non-character item '%s'", name);
+    return false;
+  }
+  int kind{pair->second};
+  SubscriptValue chars{static_cast<SubscriptValue>(desc.ElementBytes()) / kind};
+  // Allow for blanks in substring bounds; they're nonstandard, but not
+  // ambiguous within the parentheses.
+  io.HandleRelativePosition(1); // skip '('
+  std::optional<SubscriptValue> lower, upper;
+  std::optional<char32_t> ch{io.GetNextNonBlank()};
+  if (ch) {
+    if (*ch == ':') {
+      lower = 1;
+    } else {
+      lower = GetSubscriptValue(io);
+      ch = io.GetNextNonBlank();
+    }
+  }
+  if (ch && ch == ':') {
+    io.HandleRelativePosition(1);
+    ch = io.GetNextNonBlank();
+    if (ch) {
+      if (*ch == ')') {
+        upper = chars;
+      } else {
+        upper = GetSubscriptValue(io);
+        ch = io.GetNextNonBlank();
+      }
+    }
+  }
+  if (ch && *ch == ')') {
+    io.HandleRelativePosition(1);
+    if (lower && upper) {
+      if (*lower > *upper) {
+        // An empty substring, whatever the values are
+        desc.raw().elem_len = 0;
+        return true;
+      }
+      if (*lower >= 1 || *upper <= chars) {
+        // Offset the base address & adjust the element byte length
+        desc.raw().elem_len = (*upper - *lower + 1) * kind;
+        desc.set_base_addr(reinterpret_cast<void *>(
+            reinterpret_cast<char *>(desc.raw().base_addr) +
+            kind * (*lower - 1)));
+        return true;
+      }
+    }
+    handler.SignalError(
+        "Bad substring bounds for NAMELIST input group item '%s'", name);
+  } else {
+    handler.SignalError(
+        "Bad substring (missing ')') for NAMELIST input group item '%s'", name);
+  }
+  return false;
+}
+
 static bool HandleComponent(IoStatementState &io, Descriptor &desc,
     const Descriptor &source, const char *name) {
   IoErrorHandler &handler{io.GetIoErrorHandler()};
   io.HandleRelativePosition(1); // skip '%'
   char compName[nameBufferSize];
   if (GetLowerCaseName(io, compName, sizeof compName)) {
     const DescriptorAddendum *addendum{source.Addendum()};
     if (const typeInfo::DerivedType *
while (true) {
     }
     // Handle indexing and components, if any.  No spaces are allowed.
     // A copy of the descriptor is made if necessary.
     const Descriptor &itemDescriptor{group.item[itemIndex].descriptor};
     const Descriptor *useDescriptor{&itemDescriptor};
     StaticDescriptor<maxRank, true, 16> staticDesc[2];
     int whichStaticDesc{0};
     next = io.GetCurrentChar();
+    bool hadSubscripts{false};
+    bool hadSubstring{false};
     if (next && (*next == '(' || *next == '%')) {
       do {
         Descriptor &mutableDescriptor{staticDesc[whichStaticDesc].descriptor()};
         whichStaticDesc ^= 1;
         if (*next == '(') {
-          if (!(HandleSubscripts(
-                  io, mutableDescriptor, *useDescriptor, name))) {
+          if (!hadSubstring && (hadSubscripts || useDescriptor->rank() == 0)) {
+            mutableDescriptor = *useDescriptor;
+            mutableDescriptor.raw().attribute = CFI_attribute_pointer;
+            if (!HandleSubstring(io, mutableDescriptor, name)) {
+              return false;
+            }
+            hadSubstring = true;
+          } else if (hadSubscripts) {
+            handler.SignalError("Multiple sets of subscripts for item '%s' in "
+                                "NAMELIST group '%s'",
+                name, group.groupName);
+            return false;
+          } else if (!HandleSubscripts(
+                         io, mutableDescriptor, *useDescriptor, name)) {
             return false;
           }
+          hadSubscripts = true;
         } else {
           if (!HandleComponent(io, mutableDescriptor, *useDescriptor, name)) {
             return false;
           }
+          hadSubscripts = false;
+          hadSubstring = false;
         }
         useDescriptor = &mutableDescriptor;
         next = io.GetCurrentChar();
       } while (next && (*next == '(' || *next == '%'));
     }
     // Skip the '='
     next = io.GetNextNonBlank();
     if (!next || *next != '=') {

flang/unittests/Runtime/Namelist.cpp

TEST(NamelistTests, Subscripts) {
   OwningPtr<Descriptor> aDesc{
       MakeArray<TypeCategory::Integer, static_cast<int>(sizeof(int))>(
           std::vector<int>{2, 3}, std::vector<int>(6, 0))};
   aDesc->GetDimension(0).SetBounds(-1, 0);
   aDesc->GetDimension(1).SetBounds(-1, 1);
   const NamelistGroup::Item items[]{{"a", *aDesc}};
   const NamelistGroup group{"justa", 1, items};
   static char t1[]{"&justa A(0,1:-1:-2)=1 2/"};
-  StaticDescriptor<1, true> statDescs[2];
-  Descriptor &internalDesc{statDescs[0].descriptor()};
+  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));
   auto inStatus{IONAME(EndIoStatement)(inCookie)};
   ASSERT_EQ(inStatus, 0) << "Failed namelist input subscripts, status "
                          << static_cast<int>(inStatus);
TEST(NamelistTests, ShortArrayInput) {
   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);
 }
 
+TEST(NamelistTypes, ScalarSubstring) {
+  OwningPtr<Descriptor> scDesc{MakeArray<TypeCategory::Character, 1>(
+      std::vector<int>{}, std::vector<std::string>{"abcdefgh"}, 8)};
+  const NamelistGroup::Item items[]{{"a", *scDesc}};
+  const NamelistGroup group{"justa", 1, items};
+  static char t1[]{"&justa A(2:5)='BCDE'/"};
+  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 scalar substring input";
+  char out[32];
+  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(SetDelim)(outCookie, "apostrophe", 10));
+  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{"&JUSTA A= 'aBCDEfgh'/           "};
+  EXPECT_EQ(got, expect);
+}
+
+TEST(NamelistTypes, ArraySubstring) {
+  OwningPtr<Descriptor> scDesc{
+      MakeArray<TypeCategory::Character, 1>(std::vector<int>{2},
+          std::vector<std::string>{"abcdefgh", "ijklmnop"}, 8)};
+  const NamelistGroup::Item items[]{{"a", *scDesc}};
+  const NamelistGroup group{"justa", 1, items};
+  static char t1[]{"&justa A(:)(2:5)='BCDE' 'JKLM'/"};
+  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 scalar substring input";
+  char out[40];
+  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(SetDelim)(outCookie, "apostrophe", 10));
+  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{"&JUSTA A= 'aBCDEfgh' 'iJKLMnop'/        "};
+  EXPECT_EQ(got, expect);
+}
+
 // TODO: Internal NAMELIST error tests