[flang-commits] [PATCH] D135218: [flang][runtime] Handle array components in NAMELIST input

[Peter Klausler via Phabricator via flang-commits]

klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added a subscriber: jdoerfert.
Herald added a project: All.
klausler requested review of this revision.

A namelist input item that is a derived type component reference
needs additional processing when the base item or the component
is an array.  When both have rank > 0, the component reference
must of course be subscripted.


https://reviews.llvm.org/D135218

Files:
  flang/runtime/namelist.cpp
  flang/runtime/type-info.cpp


Index: flang/runtime/type-info.cpp
===================================================================
--- flang/runtime/type-info.cpp
+++ flang/runtime/type-info.cpp
@@ -127,6 +127,7 @@
   EstablishDescriptor(descriptor, container, terminator);
   if (subscripts) {
     descriptor.set_base_addr(container.Element<char>(subscripts) + offset_);
+    descriptor.raw().rank = 0;
   } else {
     descriptor.set_base_addr(container.OffsetElement<char>() + offset_);
   }
Index: flang/runtime/namelist.cpp
===================================================================
--- flang/runtime/namelist.cpp
+++ flang/runtime/namelist.cpp
@@ -310,7 +310,42 @@
         type{addendum ? addendum->derivedType() : nullptr}) {
       if (const typeInfo::Component *
           comp{type->FindDataComponent(compName, std::strlen(compName))}) {
-        comp->CreatePointerDescriptor(desc, source, handler);
+        bool createdDesc{false};
+        if (comp->rank() > 0 && source.rank() > 0) {
+          // If base and component are both arrays, the component name
+          // must be followed by subscripts; process them now.
+          std::size_t byteCount{0};
+          if (std::optional<char32_t> next{io.GetNextNonBlank(byteCount)};
+              next && *next == '(') {
+            io.HandleRelativePosition(byteCount); // skip over '('
+            StaticDescriptor<maxRank, true, 16> staticDesc;
+            Descriptor &tmpDesc{staticDesc.descriptor()};
+            comp->CreatePointerDescriptor(tmpDesc, source, handler);
+            if (!HandleSubscripts(io, desc, tmpDesc, compName)) {
+              return false;
+            }
+            createdDesc = true;
+          }
+        }
+        if (!createdDesc) {
+          comp->CreatePointerDescriptor(desc, source, handler);
+        }
+        if (source.rank() > 0) {
+          if (desc.rank() > 0) {
+            handler.SignalError(
+                "NAMELIST component reference '%%%s' of input group "
+                "item %s cannot be an array when its base is not scalar",
+                compName, name);
+            return false;
+          }
+          desc.raw().rank = source.rank();
+          for (int j{0}; j < source.rank(); ++j) {
+            const auto &srcDim{source.GetDimension(j)};
+            desc.GetDimension(j)
+                .SetBounds(1, srcDim.UpperBound())
+                .SetByteStride(srcDim.ByteStride());
+          }
+        }
         return true;
       } else {
         handler.SignalError(


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D135218.465197.patch
Type: text/x-patch
Size: 2509 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20221004/41df5e20/attachment.bin>