[flang] Implement more transformational intrinsic functions in runtime

[klausler]

Summary

Define APIs, naively implement, and add basic sanity unit tests for
the transformational intrinsic functions CSHIFT, EOSHIFT, PACK,
SPREAD, TRANSPOSE, and UNPACK. These are the remaining transformational
intrinsic functions that rearrange data without regard to type
(except for default boundary values in EOSHIFT); RESHAPE was already
in place as a stress test for the runtime's descriptor handling
facilities.

Code is in place to create copies of allocatable/automatic
components when transforming arrays of derived type, but it won't
do anything until we have derived type information being passed to the
runtime from the frontend.

[klausler]

Fix problems in PACK noticed by running tests in more environments.

[PeteSteinfeld]

All builds, tests, and looks good.

flang/runtime/transformational.cpp

13–17

Should we ask Mark to attempt to clarify this with the on-going standards work?

flang/module/__fortran_type_info.f90

type, public :: __builtin_c_funptr
     integer(kind=int64) :: __address
   end type
 
   type :: DerivedType
     ! "TBP" bindings appear first.  Inherited bindings, with overrides already
     ! applied, appear in the initial entries in the same order as they
     ! appear in the parent type's bindings, if any.  They are followed
     ! by new local bindings in alphabetic order of theing binding names.
-    type(Binding), pointer :: binding(:)
+    type(Binding), pointer, contiguous :: binding(:)
     character(len=:), pointer :: name
     integer(kind=int64) :: sizeInBytes
     type(DerivedType), pointer :: parent
     ! Instances of parameterized derived types use the "uninstantiated"
     ! component to point to the pristine original definition.
     type(DerivedType), pointer :: uninstantiated
     integer(kind=int64) :: typeHash
-    integer(kind=int64), pointer :: kindParameter(:) ! values of instance
-    integer(1), pointer :: lenParameterKind(:) ! INTEGER kinds of LEN types
+    integer(kind=int64), pointer, contiguous :: kindParameter(:) ! values of instance
+    integer(1), pointer, contiguous :: lenParameterKind(:) ! INTEGER kinds of LEN types
     ! Data components appear in alphabetic order.
     ! The parent component, if any, appears explicitly.
-    type(Component), pointer :: component(:) ! data components
-    type(ProcPtrComponent), pointer :: procptr(:) ! procedure pointers
+    type(Component), pointer, contiguous :: component(:) ! data components
+    type(ProcPtrComponent), pointer, contiguous :: procptr(:) ! procedure pointers
     ! Special bindings of the ancestral types are not duplicated here.
-    type(SpecialBinding), pointer :: special(:)
+    type(SpecialBinding), pointer, contiguous :: special(:)
   end type
 
   type :: Binding
     type(__builtin_c_funptr) :: proc
     character(len=:), pointer :: name
   end type
 
   ! Array bounds and type parameters of components are deferred
type :: Component ! data components, incl. object pointers
     integer(1) :: genre ! Component::Genre
     integer(1) :: category
     integer(1) :: kind
     integer(1) :: rank
     integer(1) :: __padding0(4)
     integer(kind=int64) :: offset
     type(Value) :: characterLen ! for category == Character
     type(DerivedType), pointer :: derived ! for category == Derived
-    type(Value), pointer :: lenValue(:) ! (SIZE(derived%lenParameterKind))
-    type(Value), pointer :: bounds(:, :) ! (2, rank): lower, upper
+    type(Value), pointer, contiguous :: lenValue(:) ! (SIZE(derived%lenParameterKind))
+    type(Value), pointer, contiguous :: bounds(:, :) ! (2, rank): lower, upper
     type(__builtin_c_ptr) :: initialization
   end type
 
   type :: ProcPtrComponent ! procedure pointer components
     character(len=:), pointer :: name
     integer(kind=int64) :: offset
     type(__builtin_c_funptr) :: initialization
   end type

flang/runtime/CMakeLists.txt

 # with different names
 include_directories(AFTER ${CMAKE_CURRENT_BINARY_DIR})
 
 add_flang_library(FortranRuntime
   ISO_Fortran_binding.cpp
   allocatable.cpp
   buffer.cpp
   complex-reduction.c
+  copy.cpp
   character.cpp
   connection.cpp
   derived.cpp
   descriptor.cpp
   dot-product.cpp
   edit-input.cpp
   edit-output.cpp
   environment.cpp

flang/runtime/allocatable.cpp

-//===-- runtime/allocatable.cpp ---------------------------------*- C++ -*-===//
+//===-- runtime/allocatable.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 "allocatable.h"

flang/runtime/copy.h

+//===-- runtime/copy.h -----------------------------------------*- C++ -*-===//
+//
+// 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
+//
+//===----------------------------------------------------------------------===//
+
+// Utilities that copy data in a type-aware fashion, allocating & duplicating
+// allocatable/automatic components of derived types along the way.
+
+#ifndef FORTRAN_RUNTIME_COPY_H_
+#define FORTRAN_RUNTIME_COPY_H_
+
+#include "descriptor.h"
+
+namespace Fortran::runtime {
+
+// Assigns to uninitialized storage.
+// Duplicates allocatable & automatic components.
+void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
+    const Descriptor &from, const SubscriptValue fromAt[], Terminator &);
+
+// Copies data from one allocated descriptor's array to another.
+void CopyArray(const Descriptor &to, const Descriptor &from, Terminator &);
+
+} // namespace Fortran::runtime
+#endif // FORTRAN_RUNTIME_COPY_H_

flang/runtime/copy.cpp

+//===-- runtime/copy.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 "copy.h"
+#include "allocatable.h"
+#include "descriptor.h"
+#include "terminator.h"
+#include "type-info.h"
+#include <cstring>
+
+namespace Fortran::runtime {
+
+void CopyElement(const Descriptor &to, const SubscriptValue toAt[],
+    const Descriptor &from, const SubscriptValue fromAt[],
+    Terminator &terminator) {
+  char *toPtr{to.Element<char>(toAt)};
+  const char *fromPtr{from.Element<const char>(fromAt)};
+  RUNTIME_CHECK(terminator, to.ElementBytes() == from.ElementBytes());
+  std::memcpy(toPtr, fromPtr, to.ElementBytes());
+  if (const auto *addendum{to.Addendum()}) {
+    if (const auto *derived{addendum->derivedType()}) {
+      RUNTIME_CHECK(terminator,
+          from.Addendum() && derived == from.Addendum()->derivedType());
+      const Descriptor &componentDesc{derived->component.descriptor()};
+      const typeInfo::Component *component{
+          componentDesc.OffsetElement<typeInfo::Component>()};
+      std::size_t nComponents{componentDesc.Elements()};
+      for (std::size_t j{0}; j < nComponents; ++j, ++component) {
+        if (component->genre == typeInfo::Component::Genre::Allocatable ||
+            component->genre == typeInfo::Component::Genre::Automatic) {
+          Descriptor &toDesc{
+              *reinterpret_cast<Descriptor *>(toPtr + component->offset)};
+          if (toDesc.raw().base_addr != nullptr) {
+            toDesc.set_base_addr(nullptr);
+            RUNTIME_CHECK(terminator, toDesc.Allocate() == CFI_SUCCESS);
+            const Descriptor &fromDesc{*reinterpret_cast<const Descriptor *>(
+                fromPtr + component->offset)};
+            CopyArray(toDesc, fromDesc, terminator);
+          }
+        }
+      }
+    }
+  }
+}
+
+void CopyArray(
+    const Descriptor &to, const Descriptor &from, Terminator &terminator) {
+  std::size_t elements{to.Elements()};
+  RUNTIME_CHECK(terminator, elements == from.Elements());
+  SubscriptValue toAt[maxRank], fromAt[maxRank];
+  to.GetLowerBounds(toAt);
+  from.GetLowerBounds(fromAt);
+  while (elements-- > 0) {
+    CopyElement(to, toAt, from, fromAt, terminator);
+    to.IncrementSubscripts(toAt);
+    from.IncrementSubscripts(fromAt);
+  }
+}
+} // namespace Fortran::runtime

flang/runtime/descriptor.h

public:
   template <typename A> A *ZeroBasedIndexedElement(std::size_t n) const {
     SubscriptValue at[maxRank];
     if (SubscriptsForZeroBasedElementNumber(at, n)) {
       return Element<A>(at);
     }
     return nullptr;
   }
 
-  void GetLowerBounds(SubscriptValue subscript[]) const {
+  int GetLowerBounds(SubscriptValue subscript[]) const {
     for (int j{0}; j < raw_.rank; ++j) {
       subscript[j] = GetDimension(j).LowerBound();
     }
+    return raw_.rank;
+  }
+
+  int GetShape(SubscriptValue subscript[]) const {
+    for (int j{0}; j < raw_.rank; ++j) {
+      subscript[j] = GetDimension(j).Extent();
+    }
+    return raw_.rank;
   }
 
   // When the passed subscript vector contains the last (or first)
   // subscripts of the array, these wrap the subscripts around to
   // their first (or last) values and return false.
   bool IncrementSubscripts(
       SubscriptValue[], const int *permutation = nullptr) const;
   bool DecrementSubscripts(

flang/runtime/tools.h

 
 template <typename TO, typename FROM>
 inline void PutContiguousConverted(TO *to, FROM *from, std::size_t count) {
   while (count-- > 0) {
     *to++ = *from++;
   }
 }
 
-static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
+static inline std::int64_t GetInt64(
+    const char *p, std::size_t bytes, Terminator &terminator) {
   switch (bytes) {
   case 1:
     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
   case 2:
     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 2> *>(p);
   case 4:
     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 4> *>(p);
   case 8:
     return *reinterpret_cast<const CppTypeFor<TypeCategory::Integer, 8> *>(p);
   default:
-    Terminator{__FILE__, __LINE__}.Crash(
-        "GetInt64: no case for %zd bytes", bytes);
+    terminator.Crash("GetInt64: no case for %zd bytes", bytes);
   }
 }
 
 template <typename INT>
 inline bool SetInteger(INT &x, int kind, std::int64_t value) {
   switch (kind) {
   case 1:
     reinterpret_cast<CppTypeFor<TypeCategory::Integer, 1> &>(x) = value;
case TypeCategory::Logical:
     } else {
       return std::nullopt;
     }
   default:
     break;
   }
   return std::nullopt;
 }
-
 } // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TOOLS_H_

flang/runtime/tools.cpp

void CheckConformability(const Descriptor &to, const Descriptor &x,
   }
 }
 
 void CheckIntegerKind(Terminator &terminator, int kind, const char *intrinsic) {
   if (kind < 1 || kind > 16 || (kind & (kind - 1)) != 0) {
     terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind);
   }
 }
-
 } // namespace Fortran::runtime

flang/runtime/transformational.h

 //===-- runtime/transformational.h ------------------------------*- C++ -*-===//
 //
 // 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
 //
 //===----------------------------------------------------------------------===//
 
+// Defines the API for the type-independent transformational intrinsic functions
+// that rearrange data in arrays: CSHIFT, EOSHIFT, PACK, RESHAPE, SPREAD,
+// TRANSPOSE, and UNPACK.
+// These are naive allocating implementations; optimized forms that manipulate
+// pointer descriptors or that supply functional views of arrays remain to
+// be defined and may instead be part of lowering (see docs/ArrayComposition.md)
+// for details).
+
 #ifndef FORTRAN_RUNTIME_TRANSFORMATIONAL_H_
 #define FORTRAN_RUNTIME_TRANSFORMATIONAL_H_
 
 #include "descriptor.h"
 #include "entry-names.h"
 #include "memory.h"
 
 namespace Fortran::runtime {
+extern "C" {
+
+void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
+    const Descriptor &shift, int dim = 1, const char *sourceFile = nullptr,
+    int line = 0);
+void RTNAME(CshiftVector)(Descriptor &result, const Descriptor &source,
+    std::int64_t shift, const char *sourceFile = nullptr, int line = 0);
+
+void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
+    const Descriptor &shift, const Descriptor *boundary = nullptr, int dim = 1,
+    const char *sourceFile = nullptr, int line = 0);
+void RTNAME(EoshiftVector)(Descriptor &result, const Descriptor &source,
+    std::int64_t shift, const Descriptor *boundary = nullptr,
+    const char *sourceFile = nullptr, int line = 0);
+
+void RTNAME(Pack)(Descriptor &result, const Descriptor &source,
+    const Descriptor &mask, const Descriptor *vector = nullptr,
+    const char *sourceFile = nullptr, int line = 0);
 
+// TODO: redo API
 OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
     const Descriptor &shape, const Descriptor *pad = nullptr,
-    const Descriptor *order = nullptr);
-}
+    const Descriptor *order = nullptr, const char *sourceFile = nullptr,
+    int line = 0);
+
+void RTNAME(Spread)(Descriptor &result, const Descriptor &source, int dim,
+    std::int64_t ncopies, const char *sourceFile = nullptr, int line = 0);
+
+void RTNAME(Transpose)(Descriptor &result, const Descriptor &matrix,
+    const char *sourceFile = nullptr, int line = 0);
+
+void RTNAME(Unpack)(Descriptor &result, const Descriptor &vector,
+    const Descriptor &mask, const Descriptor &field,
+    const char *sourceFile = nullptr, int line = 0);
+
+} // extern "C"
+} // namespace Fortran::runtime
 #endif // FORTRAN_RUNTIME_TRANSFORMATIONAL_H_

flang/runtime/transformational.cpp

 //===-- runtime/transformational.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
 //
 //===----------------------------------------------------------------------===//
 
+// Implements the transformational intrinsic functions of Fortran 2018 that
+// rearrange or duplicate data without (much) regard to type.  These are
+// CSHIFT, EOSHIFT, PACK, RESHAPE, SPREAD, TRANSPOSE, and UNPACK.
+//
+// Many of these are defined in the 2018 standard with text that makes sense
+// only if argument arrays have lower bounds of one.  Rather than interpret
+// these cases as implying a hidden constraint, these implementations
+// work with arbitrary lower bounds.  This may be technically an extension
+// of the standard but it more likely to conform with its intent.
+
 #include "transformational.h"
+#include "copy.h"
 #include "terminator.h"
 #include "tools.h"
 #include <algorithm>
-#include <cinttypes>
 
 namespace Fortran::runtime {
 
+// Utility for CSHIFT & EOSHIFT rank > 1 cases that determines the shift count
+// for each of the vector sections of the result.
+class ShiftControl {
+public:
+  ShiftControl(const Descriptor &s, Terminator &t, int dim)
+      : shift_{s}, terminator_{t}, shiftRank_{s.rank()}, dim_{dim} {}
+  void Init(const Descriptor &source) {
+    int rank{source.rank()};
+    RUNTIME_CHECK(terminator_, shiftRank_ == 0 || shiftRank_ == rank - 1);
+    auto catAndKind{shift_.type().GetCategoryAndKind()};
+    RUNTIME_CHECK(
+        terminator_, catAndKind && catAndKind->first == TypeCategory::Integer);
+    shiftElemLen_ = catAndKind->second;
+    if (shiftRank_ > 0) {
+      int k{0};
+      for (int j{0}; j < rank; ++j) {
+        if (j + 1 != dim_) {
+          const Dimension &shiftDim{shift_.GetDimension(k)};
+          lb_[k++] = shiftDim.LowerBound();
+          RUNTIME_CHECK(terminator_,
+              shiftDim.Extent() == source.GetDimension(j).Extent());
+        }
+      }
+    } else {
+      shiftCount_ =
+          GetInt64(shift_.OffsetElement<char>(), shiftElemLen_, terminator_);
+    }
+  }
+  SubscriptValue GetShift(const SubscriptValue resultAt[]) const {
+    if (shiftRank_ > 0) {
+      SubscriptValue shiftAt[maxRank];
+      int k{0};
+      for (int j{0}; j < shiftRank_ + 1; ++j) {
+        if (j + 1 != dim_) {
+          shiftAt[k] = lb_[k] + resultAt[j] - 1;
+          ++k;
+        }
+      }
+      return GetInt64(
+          shift_.Element<char>(shiftAt), shiftElemLen_, terminator_);
+    } else {
+      return shiftCount_; // invariant count extracted in Init()
+    }
+  }
+
+private:
+  const Descriptor &shift_;
+  Terminator &terminator_;
+  int shiftRank_;
+  int dim_;
+  SubscriptValue lb_[maxRank];
+  std::size_t shiftElemLen_;
+  SubscriptValue shiftCount_{};
+};
+
+// Fill an EOSHIFT result with default boundary values
+static void DefaultInitialize(
+    const Descriptor &result, Terminator &terminator) {
+  auto catAndKind{result.type().GetCategoryAndKind()};
+  RUNTIME_CHECK(
+      terminator, catAndKind && catAndKind->first != TypeCategory::Derived);
+  std::size_t elementLen{result.ElementBytes()};
+  std::size_t bytes{result.Elements() * elementLen};
+  if (catAndKind->first == TypeCategory::Character) {
+    switch (int kind{catAndKind->second}) {
+    case 1:
+      std::fill_n(result.OffsetElement<char>(), bytes, ' ');
+      break;
+    case 2:
+      std::fill_n(result.OffsetElement<char16_t>(), bytes / 2,
+          static_cast<char16_t>(' '));
+      break;
+    case 4:
+      std::fill_n(result.OffsetElement<char32_t>(), bytes / 4,
+          static_cast<char32_t>(' '));
+      break;
+    default:
+      terminator.Crash("EOSHIFT: bad CHARACTER kind %d", kind);
+    }
+  } else {
+    std::memset(result.raw().base_addr, 0, bytes);
+  }
+}
+
+static inline std::size_t AllocateResult(Descriptor &result,
+    const Descriptor &source, int rank, const SubscriptValue extent[],
+    Terminator &terminator, const char *function) {
+  std::size_t elementLen{source.ElementBytes()};
+  const DescriptorAddendum *sourceAddendum{source.Addendum()};
+  result.Establish(source.type(), elementLen, nullptr, rank, extent,
+      CFI_attribute_allocatable, sourceAddendum != nullptr);
+  if (sourceAddendum) {
+    *result.Addendum() = *sourceAddendum;
+  }
+  for (int j{0}; j < rank; ++j) {
+    result.GetDimension(j).SetBounds(1, extent[j]);
+  }
+  if (int stat{result.Allocate()}) {
+    terminator.Crash(
+        "%s: Could not allocate memory for result (stat=%d)", function, stat);
+  }
+  return elementLen;
+}
+
+extern "C" {
+
+// CSHIFT of rank > 1
+void RTNAME(Cshift)(Descriptor &result, const Descriptor &source,
+    const Descriptor &shift, int dim, const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  int rank{source.rank()};
+  RUNTIME_CHECK(terminator, rank > 1);
+  RUNTIME_CHECK(terminator, dim >= 1 && dim <= rank);
+  ShiftControl shiftControl{shift, terminator, dim};
+  shiftControl.Init(source);
+  SubscriptValue extent[maxRank];
+  source.GetShape(extent);
+  AllocateResult(result, source, rank, extent, terminator, "CSHIFT");
+  SubscriptValue resultAt[maxRank];
+  for (int j{0}; j < rank; ++j) {
+    resultAt[j] = 1;
+  }
+  SubscriptValue sourceLB[maxRank];
+  source.GetLowerBounds(sourceLB);
+  SubscriptValue dimExtent{extent[dim - 1]};
+  SubscriptValue dimLB{sourceLB[dim - 1]};
+  SubscriptValue &resDim{resultAt[dim - 1]};
+  for (std::size_t n{result.Elements()}; n > 0; n -= dimExtent) {
+    SubscriptValue shiftCount{shiftControl.GetShift(resultAt)};
+    SubscriptValue sourceAt[maxRank];
+    for (int j{0}; j < rank; ++j) {
+      sourceAt[j] = sourceLB[j] + resultAt[j] - 1;
+    }
+    SubscriptValue &sourceDim{sourceAt[dim - 1]};
+    sourceDim = dimLB + shiftCount % dimExtent;
+    if (shiftCount < 0) {
+      sourceDim += dimExtent;
+    }
+    for (resDim = 1; resDim <= dimExtent; ++resDim) {
+      CopyElement(result, resultAt, source, sourceAt, terminator);
+      if (++sourceDim == dimLB + dimExtent) {
+        sourceDim = dimLB;
+      }
+    }
+    result.IncrementSubscripts(resultAt);
+  }
+}
+
+// CSHIFT of vector
+void RTNAME(CshiftVector)(Descriptor &result, const Descriptor &source,
+    std::int64_t shift, const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  RUNTIME_CHECK(terminator, source.rank() == 1);
+  const Dimension &sourceDim{source.GetDimension(0)};
+  SubscriptValue extent{sourceDim.Extent()};
+  AllocateResult(result, source, 1, &extent, terminator, "CSHIFT");
+  SubscriptValue lb{sourceDim.LowerBound()};
+  for (SubscriptValue j{0}; j < extent; ++j) {
+    SubscriptValue resultAt{1 + j};
+    SubscriptValue sourceAt{lb + (j + shift) % extent};
+    CopyElement(result, &resultAt, source, &sourceAt, terminator);
+  }
+}
+
+// EOSHIFT of rank > 1
+void RTNAME(Eoshift)(Descriptor &result, const Descriptor &source,
+    const Descriptor &shift, const Descriptor *boundary, int dim,
+    const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  SubscriptValue extent[maxRank];
+  int rank{source.GetShape(extent)};
+  RUNTIME_CHECK(terminator, rank > 1);
+  RUNTIME_CHECK(terminator, dim >= 1 && dim <= rank);
+  std::size_t elementLen{
+      AllocateResult(result, source, rank, extent, terminator, "EOSHIFT")};
+  int boundaryRank{-1};
+  if (boundary) {
+    boundaryRank = boundary->rank();
+    RUNTIME_CHECK(terminator, boundaryRank == 0 || boundaryRank == rank - 1);
+    RUNTIME_CHECK(terminator,
+        boundary->type() == source.type() &&
+            boundary->ElementBytes() == elementLen);
+    if (boundaryRank > 0) {
+      int k{0};
+      for (int j{0}; j < rank; ++j) {
+        if (j != dim - 1) {
+          RUNTIME_CHECK(
+              terminator, boundary->GetDimension(k).Extent() == extent[j]);
+          ++k;
+        }
+      }
+    }
+  }
+  ShiftControl shiftControl{shift, terminator, dim};
+  shiftControl.Init(source);
+  SubscriptValue resultAt[maxRank];
+  for (int j{0}; j < rank; ++j) {
+    resultAt[j] = 1;
+  }
+  if (!boundary) {
+    DefaultInitialize(result, terminator);
+  }
+  SubscriptValue sourceLB[maxRank];
+  source.GetLowerBounds(sourceLB);
+  SubscriptValue boundaryAt[maxRank];
+  if (boundaryRank > 0) {
+    boundary->GetLowerBounds(boundaryAt);
+  }
+  SubscriptValue dimExtent{extent[dim - 1]};
+  SubscriptValue dimLB{sourceLB[dim - 1]};
+  SubscriptValue &resDim{resultAt[dim - 1]};
+  for (std::size_t n{result.Elements()}; n > 0; n -= dimExtent) {
+    SubscriptValue shiftCount{shiftControl.GetShift(resultAt)};
+    SubscriptValue sourceAt[maxRank];
+    for (int j{0}; j < rank; ++j) {
+      sourceAt[j] = sourceLB[j] + resultAt[j] - 1;
+    }
+    SubscriptValue &sourceDim{sourceAt[dim - 1]};
+    sourceDim = dimLB + shiftCount;
+    for (resDim = 1; resDim <= dimExtent; ++resDim) {
+      if (sourceDim >= dimLB && sourceDim < dimLB + dimExtent) {
+        CopyElement(result, resultAt, source, sourceAt, terminator);
+      } else if (boundary) {
+        CopyElement(result, resultAt, *boundary, boundaryAt, terminator);
+      }
+      ++sourceDim;
+    }
+    result.IncrementSubscripts(resultAt);
+    if (boundaryRank > 0) {
+      boundary->IncrementSubscripts(boundaryAt);
+    }
+  }
+}
+
+// EOSHIFT of vector
+void RTNAME(EoshiftVector)(Descriptor &result, const Descriptor &source,
+    std::int64_t shift, const Descriptor *boundary, const char *sourceFile,
+    int line) {
+  Terminator terminator{sourceFile, line};
+  RUNTIME_CHECK(terminator, source.rank() == 1);
+  SubscriptValue extent{source.GetDimension(0).Extent()};
+  std::size_t elementLen{
+      AllocateResult(result, source, 1, &extent, terminator, "EOSHIFT")};
+  std::optional<int> blankFill; // kind of character
+  if (boundary) {
+    RUNTIME_CHECK(terminator, boundary->rank() == 0);
+    RUNTIME_CHECK(terminator,
+        boundary->type() == source.type() &&
+            boundary->ElementBytes() == elementLen);
+  }
+  if (!boundary) {
+    DefaultInitialize(result, terminator);
+  }
+  SubscriptValue lb{source.GetDimension(0).LowerBound()};
+  for (SubscriptValue j{1}; j <= extent; ++j) {
+    SubscriptValue sourceAt{lb + j - 1 + shift};
+    if (sourceAt >= lb && sourceAt < lb + extent) {
+      CopyElement(result, &j, source, &sourceAt, terminator);
+    }
+  }
+}
+
+// PACK
+void RTNAME(Pack)(Descriptor &result, const Descriptor &source,
+    const Descriptor &mask, const Descriptor *vector, const char *sourceFile,
+    int line) {
+  Terminator terminator{sourceFile, line};
+  CheckConformability(source, mask, terminator, "PACK", "ARRAY=", "MASK=");
+  auto maskType{mask.type().GetCategoryAndKind()};
+  RUNTIME_CHECK(
+      terminator, maskType && maskType->first == TypeCategory::Logical);
+  SubscriptValue trues{0};
+  if (mask.rank() == 0) {
+    if (IsLogicalElementTrue(mask, nullptr)) {
+      trues = source.Elements();
+    }
+  } else {
+    SubscriptValue maskAt[maxRank];
+    mask.GetLowerBounds(maskAt);
+    for (std::size_t n{mask.Elements()}; n > 0; --n) {
+      if (IsLogicalElementTrue(mask, maskAt)) {
+        ++trues;
+      }
+      mask.IncrementSubscripts(maskAt);
+    }
+  }
+  SubscriptValue extent{trues};
+  if (vector) {
+    RUNTIME_CHECK(terminator, vector->rank() == 1);
+    RUNTIME_CHECK(terminator,
+        source.type() == vector->type() &&
+            source.ElementBytes() == vector->ElementBytes());
+    extent = vector->GetDimension(0).Extent();
+    RUNTIME_CHECK(terminator, extent >= trues);
+  }
+  AllocateResult(result, source, 1, &extent, terminator, "PACK");
+  SubscriptValue sourceAt[maxRank], resultAt{1};
+  source.GetLowerBounds(sourceAt);
+  if (mask.rank() == 0) {
+    if (IsLogicalElementTrue(mask, nullptr)) {
+      for (SubscriptValue n{trues}; n > 0; --n) {
+        CopyElement(result, &resultAt, source, sourceAt, terminator);
+        ++resultAt;
+        source.IncrementSubscripts(sourceAt);
+      }
+    }
+  } else {
+    SubscriptValue maskAt[maxRank];
+    mask.GetLowerBounds(maskAt);
+    for (std::size_t n{source.Elements()}; n > 0; --n) {
+      if (IsLogicalElementTrue(mask, maskAt)) {
+        CopyElement(result, &resultAt, source, sourceAt, terminator);
+        ++resultAt;
+      }
+      source.IncrementSubscripts(sourceAt);
+      mask.IncrementSubscripts(maskAt);
+    }
+  }
+  if (vector) {
+    SubscriptValue vectorAt{
+        vector->GetDimension(0).LowerBound() + resultAt - 1};
+    for (; resultAt <= extent; ++resultAt, ++vectorAt) {
+      CopyElement(result, &resultAt, *vector, &vectorAt, terminator);
+    }
+  }
+}
+
 // F2018 16.9.163
 OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
-    const Descriptor &shape, const Descriptor *pad, const Descriptor *order) {
+    const Descriptor &shape, const Descriptor *pad, const Descriptor *order,
+    const char *sourceFile, int line) {
   // Compute and check the rank of the result.
-  Terminator terminator{__FILE__, __LINE__};
+  Terminator terminator{sourceFile, line};
   RUNTIME_CHECK(terminator, shape.rank() == 1);
   RUNTIME_CHECK(terminator, shape.type().IsInteger());
   SubscriptValue resultRank{shape.GetDimension(0).Extent()};
   RUNTIME_CHECK(terminator,
       resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
 
   // Extract and check the shape of the result; compute its element count.
   SubscriptValue lowerBound[maxRank]; // all 1's
   SubscriptValue resultExtent[maxRank];
   std::size_t shapeElementBytes{shape.ElementBytes()};
   std::size_t resultElements{1};
   SubscriptValue shapeSubscript{shape.GetDimension(0).LowerBound()};
   for (SubscriptValue j{0}; j < resultRank; ++j, ++shapeSubscript) {
     lowerBound[j] = 1;
-    resultExtent[j] =
-        GetInt64(shape.Element<char>(&shapeSubscript), shapeElementBytes);
+    resultExtent[j] = GetInt64(
+        shape.Element<char>(&shapeSubscript), shapeElementBytes, terminator);
     RUNTIME_CHECK(terminator, resultExtent[j] >= 0);
     resultElements *= resultExtent[j];
   }
 
   // Check that there are sufficient elements in the SOURCE=, or that
   // the optional PAD= argument is present and nonempty.
   std::size_t elementBytes{source.ElementBytes()};
   std::size_t sourceElements{source.Elements()};
   std::size_t padElements{pad ? pad->Elements() : 0};
   if (resultElements < sourceElements) {
     RUNTIME_CHECK(terminator, padElements > 0);
     RUNTIME_CHECK(terminator, pad->ElementBytes() == elementBytes);
   }
 
   // Extract and check the optional ORDER= argument, which must be a
   // permutation of [1..resultRank].
   int dimOrder[maxRank];
   if (order) {
     RUNTIME_CHECK(terminator, order->rank() == 1);
     RUNTIME_CHECK(terminator, order->type().IsInteger());
     RUNTIME_CHECK(terminator, order->GetDimension(0).Extent() == resultRank);
     std::uint64_t values{0};
     SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()};
     for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) {
-      auto k{GetInt64(
-          order->OffsetElement<char>(orderSubscript), shapeElementBytes)};
+      auto k{GetInt64(order->OffsetElement<char>(orderSubscript),
+          shapeElementBytes, terminator)};
       RUNTIME_CHECK(
           terminator, k >= 1 && k <= resultRank && !((values >> k) & 1));
       values |= std::uint64_t{1} << k;
       dimOrder[k - 1] = j;
     }
   } else {
     for (int j{0}; j < resultRank; ++j) {
       dimOrder[j] = j;
OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
   // Populate the result's elements.
   SubscriptValue resultSubscript[maxRank];
   result->GetLowerBounds(resultSubscript);
   SubscriptValue sourceSubscript[maxRank];
   source.GetLowerBounds(sourceSubscript);
   std::size_t resultElement{0};
   std::size_t elementsFromSource{std::min(resultElements, sourceElements)};
   for (; resultElement < elementsFromSource; ++resultElement) {
-    std::memcpy(result->Element<void>(resultSubscript),
-        source.Element<const void>(sourceSubscript), elementBytes);
+    CopyElement(*result, resultSubscript, source, sourceSubscript, terminator);
     source.IncrementSubscripts(sourceSubscript);
     result->IncrementSubscripts(resultSubscript, dimOrder);
   }
   if (resultElement < resultElements) {
     // Remaining elements come from the optional PAD= argument.
     SubscriptValue padSubscript[maxRank];
     pad->GetLowerBounds(padSubscript);
     for (; resultElement < resultElements; ++resultElement) {
-      std::memcpy(result->Element<void>(resultSubscript),
-          pad->Element<const void>(padSubscript), elementBytes);
+      CopyElement(*result, resultSubscript, *pad, padSubscript, terminator);
       pad->IncrementSubscripts(padSubscript);
       result->IncrementSubscripts(resultSubscript, dimOrder);
     }
   }
 
   return result;
 }
+
+// SPREAD
+void RTNAME(Spread)(Descriptor &result, const Descriptor &source, int dim,
+    std::int64_t ncopies, const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  int rank{source.rank() + 1};
+  RUNTIME_CHECK(terminator, rank <= maxRank);
+  ncopies = std::max<std::int64_t>(ncopies, 0);
+  SubscriptValue extent[maxRank];
+  int k{0};
+  for (int j{0}; j < rank; ++j) {
+    extent[j] = j == dim - 1 ? ncopies : source.GetDimension(k++).Extent();
+  }
+  AllocateResult(result, source, rank, extent, terminator, "SPREAD");
+  SubscriptValue resultAt[maxRank];
+  for (int j{0}; j < rank; ++j) {
+    resultAt[j] = 1;
+  }
+  SubscriptValue &resultDim{resultAt[dim - 1]};
+  SubscriptValue sourceAt[maxRank];
+  source.GetLowerBounds(sourceAt);
+  for (std::size_t n{result.Elements()}; n > 0; n -= ncopies) {
+    for (resultDim = 1; resultDim <= ncopies; ++resultDim) {
+      CopyElement(result, resultAt, source, sourceAt, terminator);
+    }
+    result.IncrementSubscripts(resultAt);
+    source.IncrementSubscripts(sourceAt);
+  }
+}
+
+// TRANSPOSE
+void RTNAME(Transpose)(Descriptor &result, const Descriptor &matrix,
+    const char *sourceFile, int line) {
+  Terminator terminator{sourceFile, line};
+  RUNTIME_CHECK(terminator, matrix.rank() == 2);
+  SubscriptValue extent[2]{
+      matrix.GetDimension(1).Extent(), matrix.GetDimension(0).Extent()};
+  AllocateResult(result, matrix, 2, extent, terminator, "TRANSPOSE");
+  SubscriptValue resultAt[2]{1, 1};
+  SubscriptValue matrixLB[2];
+  matrix.GetLowerBounds(matrixLB);
+  for (std::size_t n{result.Elements()}; n-- > 0;
+       result.IncrementSubscripts(resultAt)) {
+    SubscriptValue matrixAt[2]{
+        matrixLB[0] + resultAt[1] - 1, matrixLB[1] + resultAt[0] - 1};
+    CopyElement(result, resultAt, matrix, matrixAt, terminator);
+  }
+}
+
+// UNPACK
+void RTNAME(Unpack)(Descriptor &result, const Descriptor &vector,
+    const Descriptor &mask, const Descriptor &field, const char *sourceFile,
+    int line) {
+  Terminator terminator{sourceFile, line};
+  RUNTIME_CHECK(terminator, vector.rank() == 1);
+  int rank{mask.rank()};
+  RUNTIME_CHECK(terminator, rank > 0);
+  SubscriptValue extent[maxRank];
+  mask.GetShape(extent);
+  CheckConformability(mask, field, terminator, "UNPACK", "MASK=", "FIELD=");
+  std::size_t elementLen{
+      AllocateResult(result, field, rank, extent, terminator, "UNPACK")};
+  RUNTIME_CHECK(terminator,
+      vector.type() == field.type() && vector.ElementBytes() == elementLen);
+  SubscriptValue resultAt[maxRank], maskAt[maxRank], fieldAt[maxRank],
+      vectorAt{vector.GetDimension(0).LowerBound()};
+  for (int j{0}; j < rank; ++j) {
+    resultAt[j] = 1;
+  }
+  mask.GetLowerBounds(maskAt);
+  field.GetLowerBounds(fieldAt);
+  SubscriptValue vectorLeft{vector.GetDimension(0).Extent()};
+  for (std::size_t n{result.Elements()}; n-- > 0;) {
+    if (IsLogicalElementTrue(mask, maskAt)) {
+      if (vectorLeft-- == 0) {
+        terminator.Crash("UNPACK: VECTOR= argument has fewer elements than "
+                         "MASK= has .TRUE. entries");
+      }
+      CopyElement(result, resultAt, vector, &vectorAt, terminator);
+      ++vectorAt;
+    } else {
+      CopyElement(result, resultAt, field, fieldAt, terminator);
+    }
+    result.IncrementSubscripts(resultAt);
+    mask.IncrementSubscripts(maskAt);
+    field.IncrementSubscripts(fieldAt);
+  }
+}
+
+} // extern "C"
 } // namespace Fortran::runtime

flang/runtime/type-info.h

 class DerivedType {
 public:
   ~DerivedType();
 
   // This member comes first because it's used like a vtable by generated code.
   // It includes all of the ancestor types' bindings, if any, first,
   // with any overrides from descendants already applied to them.  Local
   // bindings then follow in alphabetic order of binding name.
-  StaticDescriptor<1> binding; // TYPE(BINDING), DIMENSION(:), POINTER
+  StaticDescriptor<1, true>
+      binding; // TYPE(BINDING), DIMENSION(:), POINTER, CONTIGUOUS
 
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
 
   std::uint64_t sizeInBytes{0};
-  StaticDescriptor<0> parent; // TYPE(DERIVEDTYPE), POINTER
+  StaticDescriptor<0, true> parent; // TYPE(DERIVEDTYPE), POINTER
 
   // Instantiations of a parameterized derived type with KIND type
   // parameters will point this data member to the description of
   // the original uninstantiated type, which may be shared from a
   // module via use association.  The original uninstantiated derived
   // type description will point to itself.  Derived types that have
   // no KIND type parameters will have a null pointer here.
-  StaticDescriptor<0> uninstantiated; // TYPE(DERIVEDTYPE), POINTER
+  StaticDescriptor<0, true> uninstantiated; // TYPE(DERIVEDTYPE), POINTER
 
   // TODO: flags for SEQUENCE, BIND(C), any PRIVATE component(? see 7.5.2)
   std::uint64_t typeHash{0};
 
   // These pointer targets include all of the items from the parent, if any.
   StaticDescriptor<1> kindParameter; // pointer to rank-1 array of INTEGER(8)
   StaticDescriptor<1> lenParameterKind; // pointer to rank-1 array of INTEGER(1)
 
   // This array of local data components includes the parent component.
   // Components are in alphabetic order.
   // It does not include procedure pointer components.
-  StaticDescriptor<1, true> component; // TYPE(COMPONENT), POINTER, DIMENSION(:)
+  StaticDescriptor<1, true>
+      component; // TYPE(COMPONENT), POINTER, DIMENSION(:), CONTIGUOUS
 
   // Procedure pointer components
-  StaticDescriptor<1, true> procPtr; // TYPE(PROCPTR), POINTER, DIMENSION(:)
+  StaticDescriptor<1, true>
+      procPtr; // TYPE(PROCPTR), POINTER, DIMENSION(:), CONTIGUOUS
 
   // Does not include special bindings from ancestral types.
   StaticDescriptor<1, true>
-      special; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:)
+      special; // TYPE(SPECIALBINDING), POINTER, DIMENSION(:), CONTIGUOUS
 
   std::size_t LenParameters() const {
     return lenParameterKind.descriptor().Elements();
   }
 };
 
 using ProcedurePointer = void (*)(); // TYPE(C_FUNPTR)
 
struct Component {
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
   Genre genre{Genre::Data};
   std::uint8_t category; // common::TypeCategory
   std::uint8_t kind{0};
   std::uint8_t rank{0};
   std::uint64_t offset{0};
   Value characterLen; // for TypeCategory::Character
   StaticDescriptor<0, true> derivedType; // TYPE(DERIVEDTYPE), POINTER
-  StaticDescriptor<1, true> lenValue; // TYPE(VALUE), POINTER, DIMENSION(:)
-  StaticDescriptor<2, true> bounds; // TYPE(VALUE), POINTER, DIMENSION(2,:)
+  StaticDescriptor<1, true>
+      lenValue; // TYPE(VALUE), POINTER, DIMENSION(:), CONTIGUOUS
+  StaticDescriptor<2, true>
+      bounds; // TYPE(VALUE), POINTER, DIMENSION(2,:), CONTIGUOUS
   char *initialization{nullptr}; // for Genre::Data and Pointer
   // TODO: cobounds
   // TODO: `PRIVATE` attribute
 };
 
 struct ProcPtrComponent {
   StaticDescriptor<0> name; // CHARACTER(:), POINTER
   std::uint64_t offset{0};

flang/unittests/Evaluate/reshape.cpp

pad.Establish(TypeCategory::Integer, static_cast<int>(sizeof padData[0]),
       CFI_attribute_pointer);
   padDescriptor.Check();
   pad.Check();
   MATCH(3, pad.rank());
   MATCH(2, pad.GetDimension(0).Extent());
   MATCH(2, pad.GetDimension(1).Extent());
   MATCH(3, pad.GetDimension(2).Extent());
 
-  auto result{RTNAME(Reshape)(*source, *shape, &pad)};
+  auto result{
+      RTNAME(Reshape)(*source, *shape, &pad, nullptr, __FILE__, __LINE__)};
   TEST(result.get() != nullptr);
   result->Check();
   MATCH(sizeof(std::int32_t), result->ElementBytes());
   MATCH(2, result->rank());
   TEST(result->type().IsInteger());
   for (std::int32_t j{0}; j < 32; ++j) {
     MATCH(j, *result->OffsetElement<std::int32_t>(j * sizeof(std::int32_t)));
   }

flang/unittests/RuntimeGTest/CMakeLists.txt

 add_flang_unittest(FlangRuntimeTests
   CharacterTest.cpp
   CrashHandlerFixture.cpp
   Format.cpp
+  ListInputTest.cpp
   Matmul.cpp
   MiscIntrinsic.cpp
   Namelist.cpp
   Numeric.cpp
   NumericalFormatTest.cpp
   Random.cpp
   Reduction.cpp
   RuntimeCrashTest.cpp
-  ListInputTest.cpp
+  Transformational.cpp
 )
 
 target_link_libraries(FlangRuntimeTests
   PRIVATE
   FortranRuntime
 )

flang/unittests/RuntimeGTest/Matmul.cpp

TEST(Matmul, Basic) {
   //   1 3 5     7 10
   //             8 11
   auto x{MakeArray<TypeCategory::Integer, 4>(
       std::vector<int>{2, 3}, std::vector<std::int32_t>{0, 1, 2, 3, 4, 5})};
   auto y{MakeArray<TypeCategory::Integer, 2>(
       std::vector<int>{3, 2}, std::vector<std::int16_t>{6, 7, 8, 9, 10, 11})};
   auto v{MakeArray<TypeCategory::Integer, 8>(
       std::vector<int>{2}, std::vector<std::int64_t>{-1, -2})};
-  StaticDescriptor<2> statDesc;
+  StaticDescriptor<2, true> statDesc;
   Descriptor &result{statDesc.descriptor()};
 
   RTNAME(Matmul)(result, *x, *y, __FILE__, __LINE__);
   ASSERT_EQ(result.rank(), 2);
   EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(0).Extent(), 2);
   EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
   EXPECT_EQ(result.GetDimension(1).Extent(), 2);

flang/unittests/RuntimeGTest/Namelist.cpp

static void ClearDescriptorStorage(const Descriptor &descriptor) {
   std::memset(descriptor.raw().base_addr, 0,
       descriptor.Elements() * descriptor.ElementBytes());
 }
 
 TEST(NamelistTests, BasicSanity) {
   static constexpr int numLines{12};
   static constexpr int lineLength{32};
   static char buffer[numLines][lineLength];
-  StaticDescriptor<1> statDescs[1];
+  StaticDescriptor<1, true> statDescs[1];
   Descriptor &internalDesc{statDescs[0].descriptor()};
   SubscriptValue extent[]{numLines};
   internalDesc.Establish(TypeCode{CFI_type_char}, /*elementBytes=*/lineLength,
       &buffer, 1, extent, CFI_attribute_pointer);
   // Set up data arrays
   std::vector<int> ints;
   for (int j{0}; j < 20; ++j) {
     ints.push_back(j % 2 == 0 ? (1 << j) : -(1 << j));
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> statDescs[2];
+  StaticDescriptor<1, true> statDescs[2];
   Descriptor &internalDesc{statDescs[0].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 "

flang/unittests/RuntimeGTest/Reduction.cpp

-//===-- flang/unittests/RuntimeGTest/Reductions.cpp -------------*- C++ -*-===//
+//===-- flang/unittests/RuntimeGTest/Reductions.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 "../../runtime/reduction.h"

 }
 
 TEST(Reductions, DimMaskProductInt4) {
   std::vector<int> shape{2, 3};
   auto array{MakeArray<TypeCategory::Integer, 4>(
       shape, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
   auto mask{MakeArray<TypeCategory::Logical, 1>(
       shape, std::vector<bool>{true, false, false, true, true, true})};
-  StaticDescriptor<1> statDesc;
+  StaticDescriptor<1, true> statDesc;
   Descriptor &prod{statDesc.descriptor()};
   RTNAME(ProductDim)(prod, *array, 1, __FILE__, __LINE__, &*mask);
   EXPECT_EQ(prod.rank(), 1);
   EXPECT_EQ(prod.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(prod.GetDimension(0).Extent(), 3);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(0), 1);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(1), 4);
   EXPECT_EQ(*prod.ZeroBasedIndexedElement<std::int32_t>(2), 30);
TEST(Reductions, DoubleMaxMinNorm2) {
   double naiveNorm2{0};
   for (auto x : rawData) {
     naiveNorm2 += x * x;
   }
   naiveNorm2 = std::sqrt(naiveNorm2);
   double norm2Error{
       std::abs(naiveNorm2 - RTNAME(Norm2_8)(*array, __FILE__, __LINE__))};
   EXPECT_LE(norm2Error, 0.000001 * naiveNorm2);
-  StaticDescriptor<2> statDesc;
+  StaticDescriptor<2, true> statDesc;
   Descriptor &loc{statDesc.descriptor()};
   RTNAME(Maxloc)
   (loc, *array, /*KIND=*/8, __FILE__, __LINE__, /*MASK=*/nullptr,
       /*BACK=*/false);
   EXPECT_EQ(loc.rank(), 1);
   EXPECT_EQ(loc.type().raw(), (TypeCode{TypeCategory::Integer, 8}.raw()));
   EXPECT_EQ(loc.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(loc.GetDimension(0).Extent(), 3);
TEST(Reductions, DoubleMaxMinNorm2) {
   EXPECT_EQ(*loc.ZeroBasedIndexedElement<std::int16_t>(11), 2); // 22
   loc.Destroy();
 }
 
 TEST(Reductions, Character) {
   std::vector<int> shape{2, 3};
   auto array{MakeArray<TypeCategory::Character, 1>(shape,
       std::vector<std::string>{"abc", "def", "ghi", "jkl", "mno", "abc"}, 3)};
-  StaticDescriptor<1> statDesc[2];
+  StaticDescriptor<1, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   RTNAME(MaxvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Character, 1}.raw()));
   EXPECT_EQ(std::memcmp(res.OffsetElement<char>(), "mno", 3), 0);
   res.Destroy();
   RTNAME(MinvalCharacter)(res, *array, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 0);
TEST(Reductions, Logical) {
   std::vector<int> shape{2, 2};
   auto array{MakeArray<TypeCategory::Logical, 4>(
       shape, std::vector<std::int32_t>{false, false, true, true})};
   ASSERT_EQ(array->ElementBytes(), std::size_t{4});
   EXPECT_EQ(RTNAME(All)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Any)(*array, __FILE__, __LINE__), true);
   EXPECT_EQ(RTNAME(Parity)(*array, __FILE__, __LINE__), false);
   EXPECT_EQ(RTNAME(Count)(*array, __FILE__, __LINE__), 2);
-  StaticDescriptor<2> statDesc[2];
+  StaticDescriptor<2, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   RTNAME(AllDim)(res, *array, /*DIM=*/1, __FILE__, __LINE__);
   EXPECT_EQ(res.rank(), 1);
   EXPECT_EQ(res.type().raw(), (TypeCode{TypeCategory::Logical, 4}.raw()));
   EXPECT_EQ(res.GetDimension(0).LowerBound(), 1);
   EXPECT_EQ(res.GetDimension(0).Extent(), 2);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(0), 0);
   EXPECT_EQ(*res.ZeroBasedIndexedElement<std::int32_t>(1), 1);

 
 TEST(Reductions, FindlocNumeric) {
   std::vector<int> shape{2, 3};
   auto realArray{MakeArray<TypeCategory::Real, 8>(shape,
       std::vector<double>{0.0, -0.0, 1.0, 3.14,
           std::numeric_limits<double>::quiet_NaN(),
           std::numeric_limits<double>::infinity()})};
   ASSERT_EQ(realArray->ElementBytes(), sizeof(double));
-  StaticDescriptor<2> statDesc[2];
+  StaticDescriptor<2, true> statDesc[2];
   Descriptor &res{statDesc[0].descriptor()};
   // Find the first zero
   Descriptor &target{statDesc[1].descriptor()};
   double value{0.0};
   target.Establish(TypeCategory::Real, 8, static_cast<void *>(&value), 0,
       nullptr, CFI_attribute_pointer);
   RTNAME(Findloc)
   (res, *realArray, target, 8, __FILE__, __LINE__, nullptr, /*BACK=*/false);

flang/unittests/RuntimeGTest/Transformational.cpp

+//===-- flang/unittests/RuntimeGTest/Transformational.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 "../../runtime/transformational.h"
+#include "gtest/gtest.h"
+#include "tools.h"
+#include "../../runtime/type-code.h"
+
+using namespace Fortran::runtime;
+using Fortran::common::TypeCategory;
+
+TEST(Transformational, Shifts) {
+  // ARRAY  1 3 5
+  //        2 4 6
+  auto array{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
+  array->GetDimension(0).SetLowerBound(0); // shouldn't matter
+  array->GetDimension(1).SetLowerBound(-1);
+  StaticDescriptor<2, true> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+
+  auto shift3{MakeArray<TypeCategory::Integer, 8>(
+      std::vector<int>{3}, std::vector<std::int64_t>{1, -1, 2})};
+  RTNAME(Cshift)(result, *array, *shift3, 1, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 3);
+  EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
+  static std::int32_t cshiftExpect1[6]{2, 1, 4, 3, 5, 6};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(
+        *result.ZeroBasedIndexedElement<std::int32_t>(j), cshiftExpect1[j]);
+  }
+  result.Destroy();
+
+  auto shift2{MakeArray<TypeCategory::Integer, 1>(
+      std::vector<int>{2}, std::vector<std::int8_t>{1, -1})};
+  shift2->GetDimension(0).SetLowerBound(-1); // shouldn't matter
+  shift2->GetDimension(1).SetLowerBound(2);
+  RTNAME(Cshift)(result, *array, *shift2, 2, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 3);
+  EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
+  static std::int32_t cshiftExpect2[6]{3, 6, 5, 2, 1, 4};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(
+        *result.ZeroBasedIndexedElement<std::int32_t>(j), cshiftExpect2[j]);
+  }
+  result.Destroy();
+
+  auto boundary{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{3}, std::vector<std::int32_t>{-1, -2, -3})};
+  boundary->GetDimension(0).SetLowerBound(9); // shouldn't matter
+  RTNAME(Eoshift)(result, *array, *shift3, &*boundary, 1, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 3);
+  EXPECT_EQ(result.type(), (TypeCode{TypeCategory::Integer, 4}));
+  static std::int32_t eoshiftExpect1[6]{2, -1, -2, 3, -3, -3};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(
+        *result.ZeroBasedIndexedElement<std::int32_t>(j), eoshiftExpect1[j]);
+  }
+  result.Destroy();
+}
+
+TEST(Transformational, Pack) {
+  // ARRAY  1 3 5
+  //        2 4 6
+  auto array{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
+  array->GetDimension(0).SetLowerBound(2); // shouldn't matter
+  array->GetDimension(1).SetLowerBound(-1);
+  auto mask{MakeArray<TypeCategory::Logical, 1>(std::vector<int>{2, 3},
+      std::vector<std::uint8_t>{false, true, true, false, false, true})};
+  mask->GetDimension(0).SetLowerBound(0); // shouldn't matter
+  mask->GetDimension(1).SetLowerBound(2);
+  StaticDescriptor<1, true> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+
+  RTNAME(Pack)(result, *array, *mask, nullptr, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 1);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 3);
+  static std::int32_t packExpect1[3]{2, 3, 6};
+  for (int j{0}; j < 3; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), packExpect1[j])
+        << " at " << j;
+  }
+  result.Destroy();
+
+  auto vector{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{5}, std::vector<std::int32_t>{-1, -2, -3, -4, -5})};
+  RTNAME(Pack)(result, *array, *mask, &*vector, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 1);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 5);
+  static std::int32_t packExpect2[5]{2, 3, 6, -4, -5};
+  for (int j{0}; j < 5; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), packExpect2[j])
+        << " at " << j;
+  }
+  result.Destroy();
+}
+
+TEST(Transformational, Spread) {
+  auto array{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{3}, std::vector<std::int32_t>{1, 2, 3})};
+  array->GetDimension(0).SetLowerBound(2); // shouldn't matter
+  StaticDescriptor<2, true> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+
+  RTNAME(Spread)(result, *array, 1, 2, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 3);
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), 1 + j / 2);
+  }
+  result.Destroy();
+
+  RTNAME(Spread)(result, *array, 2, 2, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 3);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 2);
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), 1 + j % 3);
+  }
+  result.Destroy();
+}
+
+TEST(Transformational, Transpose) {
+  // ARRAY  1 3 5
+  //        2 4 6
+  auto array{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{2, 3}, std::vector<std::int32_t>{1, 2, 3, 4, 5, 6})};
+  array->GetDimension(0).SetLowerBound(2); // shouldn't matter
+  array->GetDimension(1).SetLowerBound(-6);
+  StaticDescriptor<2, true> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+  RTNAME(Transpose)(result, *array, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), array->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 3);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 2);
+  static std::int32_t expect[6]{1, 3, 5, 2, 4, 6};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), expect[j]);
+  }
+  result.Destroy();
+}
+
+TEST(Transformational, Unpack) {
+  auto vector{MakeArray<TypeCategory::Integer, 4>(
+      std::vector<int>{4}, std::vector<std::int32_t>{1, 2, 3, 4})};
+  vector->GetDimension(0).SetLowerBound(2); // shouldn't matter
+  auto mask{MakeArray<TypeCategory::Logical, 1>(std::vector<int>{2, 3},
+      std::vector<std::uint8_t>{false, true, true, false, false, true})};
+  mask->GetDimension(0).SetLowerBound(0); // shouldn't matter
+  mask->GetDimension(1).SetLowerBound(2);
+  auto field{MakeArray<TypeCategory::Integer, 4>(std::vector<int>{2, 3},
+      std::vector<std::int32_t>{-1, -2, -3, -4, -5, -6})};
+  field->GetDimension(0).SetLowerBound(-1); // shouldn't matter
+  StaticDescriptor<2, true> statDesc;
+  Descriptor &result{statDesc.descriptor()};
+  RTNAME(Unpack)(result, *vector, *mask, *field, __FILE__, __LINE__);
+  EXPECT_EQ(result.type(), vector->type());
+  EXPECT_EQ(result.rank(), 2);
+  EXPECT_EQ(result.GetDimension(0).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(0).Extent(), 2);
+  EXPECT_EQ(result.GetDimension(1).LowerBound(), 1);
+  EXPECT_EQ(result.GetDimension(1).Extent(), 3);
+  static std::int32_t expect[6]{-1, 1, 2, -4, -5, 3};
+  for (int j{0}; j < 6; ++j) {
+    EXPECT_EQ(*result.ZeroBasedIndexedElement<std::int32_t>(j), expect[j]);
+  }
+  result.Destroy();
+}