[flang] Implement and test RESHAPE. Avoid G++ workaround when compiled with GNU 8.2.0.

Original-commit: flang-compiler/f18@80257ee0d2
Reviewed-on: https://github.com/flang-compiler/f18/pull/162
Tree-same-pre-rewrite: false

flang/include/flang/ISO_Fortran_binding.h

@@ -51,7 +51,7 @@ typedef ptrdiff_t CFI_index_t;
     CFI_dim_t dim[rank]; \
   };
 
-typedef unsigned short CFI_attribute_t;
+typedef unsigned char CFI_attribute_t;
 #define CFI_attribute_pointer 1
 #define CFI_attribute_allocatable 2
 #define CFI_attribute_other 0 /* neither pointer nor allocatable */

flang/lib/evaluate/integer.h

@@ -431,7 +431,7 @@ public:
 
   constexpr std::int64_t ToInt64() const {
     std::int64_t signExtended = ToUInt64();
-    if (bits < 64) {
+    if constexpr (bits < 64) {
       signExtended |= -(signExtended >> (bits - 1)) << bits;
     }
     return signExtended;

flang/lib/parser/basic-parsers.h

@@ -327,7 +327,7 @@ template<typename... Ps> inline constexpr auto first(const Ps &... ps) {
   return AlternativesParser<Ps...>{ps...};
 }
 
-#if !__GNUC__ || __clang__
+#if !__GNUC__ || __clang__ || ((100 * __GNUC__ + __GNUC__MINOR__) >= 802)
 // Implement operator|| with first(), unless compiling with g++,
 // which can segfault at compile time and needs to continue to use
 // the original implementation of operator|| as of gcc-8.1.0.
@@ -335,7 +335,7 @@ template<typename PA, typename PB>
 inline constexpr auto operator||(const PA &pa, const PB &pb) {
   return first(pa, pb);
 }
-#else  // g++ only: original implementation
+#else  // g++ <= 8.1.0 only: original implementation
 // If a and b are parsers, then a || b returns a parser that succeeds if
 // a does so, or if a fails and b succeeds.  The result types of the parsers
 // must be the same type.  If a succeeds, b is not attempted.

flang/runtime/CMakeLists.txt

@@ -16,5 +16,10 @@ add_library(FortranRuntime
   ISO_Fortran_binding.cc
   derived-type.cc
   descriptor.cc
+  transformational.cc
   type-code.cc
 )
+
+target_link_libraries(FortranRuntime
+  FortranEvaluate
+)

flang/runtime/ISO_Fortran_binding.cc

@@ -144,9 +144,6 @@ int CFI_establish(CFI_cdesc_t *descriptor, void *base_addr,
   if ((attribute & ~(CFI_attribute_pointer | CFI_attribute_allocatable)) != 0) {
     return CFI_INVALID_ATTRIBUTE;
   }
-  if ((attribute & CFI_attribute_allocatable) != 0 && base_addr != nullptr) {
-    return CFI_ERROR_BASE_ADDR_NOT_NULL;
-  }
   if (rank > CFI_MAX_RANK) {
     return CFI_INVALID_RANK;
   }
@@ -166,7 +163,9 @@ int CFI_establish(CFI_cdesc_t *descriptor, void *base_addr,
   descriptor->elem_len = elem_len;
   descriptor->version = CFI_VERSION;
   descriptor->rank = rank;
+  descriptor->type = type;
   descriptor->attribute = attribute;
+  descriptor->f18Addendum = 0;
   std::size_t byteSize{elem_len};
   for (std::size_t j{0}; j < rank; ++j) {
     descriptor->dim[j].lower_bound = 1;

flang/runtime/derived-type.cc

@@ -31,7 +31,7 @@ bool DerivedType::IsNontrivialAnalysis() const {
       definedAssignments_ > 0) {
     return true;
   }
-  for (int j{0}; j < components_; ++j) {
+  for (std::size_t j{0}; j < components_; ++j) {
     if (component_[j].IsDescriptor()) {
       return true;
     }

flang/runtime/derived-type.h

@@ -122,8 +122,9 @@ struct DefinedAssignment {
 // the execution of FINAL subroutines.
 class DerivedType {
 public:
-  DerivedType(const char *n, int kps, int lps, const TypeParameter *tp, int cs,
+  DerivedType(const char *n, std::size_t kps, std::size_t lps,
-      const Component *ca, int tbps, const TypeBoundProcedure *tbp, int das,
+      const TypeParameter *tp, std::size_t cs, const Component *ca,
+      std::size_t tbps, const TypeBoundProcedure *tbp, std::size_t das,
       const DefinedAssignment *da, std::size_t sz)
     : name_{n}, kindParameters_{kps}, lenParameters_{lps}, typeParameter_{tp},
       components_{cs}, component_{ca}, typeBoundProcedures_{tbps},
@@ -135,13 +136,13 @@ public:
   }
 
   const char *name() const { return name_; }
-  int kindParameters() const { return kindParameters_; }
+  std::size_t kindParameters() const { return kindParameters_; }
-  int lenParameters() const { return lenParameters_; }
+  std::size_t lenParameters() const { return lenParameters_; }
 
   // KIND type parameters come first.
   const TypeParameter &typeParameter(int n) const { return typeParameter_[n]; }
 
-  int components() const { return components_; }
+  std::size_t components() const { return components_; }
 
   // TBP 0 is the initializer: SUBROUTINE INIT(INSTANCE)
   static constexpr int initializerTBP{0};
@@ -152,7 +153,7 @@ public:
   // TBP 2 is the FINAL subroutine.
   static constexpr int finalTBP{2};
 
-  int typeBoundProcedures() const { return typeBoundProcedures_; }
+  std::size_t typeBoundProcedures() const { return typeBoundProcedures_; }
   const TypeBoundProcedure &typeBoundProcedure(int n) const {
     return typeBoundProcedure_[n];
   }
@@ -184,14 +185,14 @@ private:
   bool IsNontrivialAnalysis() const;
 
   const char *name_{""};  // NUL-terminated constant text
-  int kindParameters_{0};
+  std::size_t kindParameters_{0};
-  int lenParameters_{0};
+  std::size_t lenParameters_{0};
   const TypeParameter *typeParameter_{nullptr};  // array
-  int components_{0};  // *not* including type parameters
+  std::size_t components_{0};  // *not* including type parameters
   const Component *component_{nullptr};  // array
-  int typeBoundProcedures_{0};
+  std::size_t typeBoundProcedures_{0};
   const TypeBoundProcedure *typeBoundProcedure_{nullptr};  // array
-  int definedAssignments_{0};
+  std::size_t definedAssignments_{0};
   const DefinedAssignment *definedAssignment_{nullptr};  // array
   std::uint64_t flags_{0};
   std::size_t bytes_{0};

flang/runtime/descriptor.cc

@@ -13,6 +13,7 @@
 // limitations under the License.
 
 #include "descriptor.h"
+#include "../lib/common/idioms.h"
 #include <cassert>
 #include <cstdlib>
 
@@ -25,41 +26,45 @@ Descriptor::~Descriptor() {
   assert(!(Addendum() && (Addendum()->flags() & DescriptorAddendum::Created)));
 }
 
-int Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
+void Descriptor::Establish(TypeCode t, std::size_t elementBytes, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {
-  int result{
+  CHECK(ISO::CFI_establish(&raw_, p, attribute, t.raw(), elementBytes, rank,
-      CFI_establish(&raw_, p, attribute, t.raw(), elementBytes, rank, extent)};
+            extent) == CFI_SUCCESS);
   raw_.f18Addendum = addendum;
-  return result;
+  if (addendum) {
+    new (Addendum()) DescriptorAddendum{};
+  }
 }
 
-int Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
+void Descriptor::Establish(TypeCategory c, int kind, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute,
     bool addendum) {
   std::size_t elementBytes = kind;
   if (c == TypeCategory::Complex) {
     elementBytes *= 2;
   }
-  int result{ISO::CFI_establish(&raw_, p, attribute, TypeCode(c, kind).raw(),
+  CHECK(ISO::CFI_establish(&raw_, p, attribute, TypeCode(c, kind).raw(),
-      elementBytes, rank, extent)};
+            elementBytes, rank, extent) == CFI_SUCCESS);
   raw_.f18Addendum = addendum;
-  return result;
+  if (addendum) {
+    new (Addendum()) DescriptorAddendum{};
+  }
 }
 
-int Descriptor::Establish(const DerivedType &dt, void *p, int rank,
+void Descriptor::Establish(const DerivedType &dt, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  int result{ISO::CFI_establish(
+  CHECK(ISO::CFI_establish(&raw_, p, attribute, CFI_type_struct,
-      &raw_, p, attribute, CFI_type_struct, dt.SizeInBytes(), rank, extent)};
+            dt.SizeInBytes(), rank, extent) == CFI_SUCCESS);
   raw_.f18Addendum = true;
-  Addendum()->set_derivedType(dt);
+  new (Addendum()) DescriptorAddendum{&dt};
-  return result;
 }
 
 Descriptor *Descriptor::Create(TypeCode t, std::size_t elementBytes, void *p,
     int rank, const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  std::size_t bytes{SizeInBytes(rank)};
+  std::size_t bytes{SizeInBytes(rank, true)};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+  Descriptor *result{reinterpret_cast<Descriptor *>(std::malloc(bytes))};
+  CHECK(result != nullptr);
   result->Establish(t, elementBytes, p, rank, extent, attribute, true);
   result->Addendum()->flags() |= DescriptorAddendum::Created;
   return result;
@@ -67,8 +72,9 @@ Descriptor *Descriptor::Create(TypeCode t, std::size_t elementBytes, void *p,
 
 Descriptor *Descriptor::Create(TypeCategory c, int kind, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  std::size_t bytes{SizeInBytes(rank)};
+  std::size_t bytes{SizeInBytes(rank, true)};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+  Descriptor *result{reinterpret_cast<Descriptor *>(std::malloc(bytes))};
+  CHECK(result != nullptr);
   result->Establish(c, kind, p, rank, extent, attribute, true);
   result->Addendum()->flags() |= DescriptorAddendum::Created;
   return result;
@@ -76,8 +82,9 @@ Descriptor *Descriptor::Create(TypeCategory c, int kind, void *p, int rank,
 
 Descriptor *Descriptor::Create(const DerivedType &dt, void *p, int rank,
     const SubscriptValue *extent, ISO::CFI_attribute_t attribute) {
-  std::size_t bytes{SizeInBytes(rank, dt.IsNontrivial(), dt.lenParameters())};
+  std::size_t bytes{SizeInBytes(rank, true, dt.lenParameters())};
-  Descriptor *result{reinterpret_cast<Descriptor *>(new char[bytes])};
+  Descriptor *result{reinterpret_cast<Descriptor *>(std::malloc(bytes))};
+  CHECK(result != nullptr);
   result->Establish(dt, p, rank, extent, attribute);
   result->Addendum()->flags() |= DescriptorAddendum::Created;
   return result;
@@ -86,7 +93,7 @@ Descriptor *Descriptor::Create(const DerivedType &dt, void *p, int rank,
 void Descriptor::Destroy() {
   if (const DescriptorAddendum * addendum{Addendum()}) {
     if (addendum->flags() & DescriptorAddendum::Created) {
-      delete[] reinterpret_cast<char *>(this);
+      std::free(reinterpret_cast<void *>(this));
     }
   }
 }
@@ -97,11 +104,20 @@ std::size_t Descriptor::SizeInBytes() const {
       (addendum ? addendum->SizeInBytes() : 0);
 }
 
+std::size_t Descriptor::Elements() const {
+  int n{rank()};
+  std::size_t elements{1};
+  for (int j{0}; j < n; ++j) {
+    elements *= GetDimension(j).Extent();
+  }
+  return elements;
+}
+
 void Descriptor::Check() const {
   // TODO
 }
 
 std::size_t DescriptorAddendum::SizeInBytes() const {
-  return SizeInBytes(derivedType_->lenParameters());
+  return SizeInBytes(LenParameters());
 }
 }  // namespace Fortran::runtime

flang/runtime/descriptor.h

@@ -70,17 +70,25 @@ public:
     LeadingDimensionContiguous = 0x040,  // only leading dimension contiguous
   };
 
-  explicit DescriptorAddendum(const DerivedType &dt, std::uint64_t flags = 0)
+  explicit DescriptorAddendum(
-    : derivedType_{&dt}, flags_{flags} {}
+      const DerivedType *dt = nullptr, std::uint64_t flags = 0)
+    : derivedType_{dt}, flags_{flags} {}
 
   const DerivedType *derivedType() const { return derivedType_; }
-  DescriptorAddendum &set_derivedType(const DerivedType &dt) {
+  DescriptorAddendum &set_derivedType(const DerivedType *dt) {
-    derivedType_ = &dt;
+    derivedType_ = dt;
     return *this;
   }
   std::uint64_t &flags() { return flags_; }
   const std::uint64_t &flags() const { return flags_; }
 
+  std::size_t LenParameters() const {
+    if (derivedType_ != nullptr) {
+      return derivedType_->lenParameters();
+    }
+    return 0;
+  }
+
   TypeParameterValue LenParameterValue(int which) const { return len_[which]; }
   static constexpr std::size_t SizeInBytes(int lenParameters) {
     return sizeof(DescriptorAddendum) - sizeof(TypeParameterValue) +
@@ -118,15 +126,15 @@ public:
 
   ~Descriptor();
 
-  int Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
+  void Establish(TypeCode t, std::size_t elementBytes, void *p = nullptr,
       int rank = maxRank, const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
       bool addendum = false);
-  int Establish(TypeCategory, int kind, void *p = nullptr, int rank = maxRank,
+  void Establish(TypeCategory, int kind, void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other,
       bool addendum = false);
-  int Establish(const DerivedType &dt, void *p = nullptr, int rank = maxRank,
+  void Establish(const DerivedType &dt, void *p = nullptr, int rank = maxRank,
       const SubscriptValue *extent = nullptr,
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
@@ -142,7 +150,7 @@ public:
       ISO::CFI_attribute_t attribute = CFI_attribute_other);
 
   // Descriptor instances allocated via Create() above must be deallocated
-  // by calling Destroy() so that operator delete[] is invoked.
+  // by calling Destroy().
   void Destroy();
 
   ISO::CFI_cdesc_t &raw() { return raw_; }
@@ -174,6 +182,41 @@ public:
     return (subscriptValue - dimension.LowerBound()) * dimension.ByteStride();
   }
 
+  std::size_t SubscriptsToByteOffset(const SubscriptValue *subscript) const {
+    std::size_t offset{0};
+    for (int j{0}; j < raw_.rank; ++j) {
+      offset += SubscriptByteOffset(j, subscript[j]);
+    }
+    return offset;
+  }
+
+  template<typename A> A *Element(std::size_t offset) const {
+    return reinterpret_cast<A *>(
+        reinterpret_cast<char *>(raw_.base_addr) + offset);
+  }
+
+  template<typename A> A *Element(const SubscriptValue *subscript) const {
+    return Element<A>(SubscriptsToByteOffset(subscript));
+  }
+
+  void GetLowerBounds(SubscriptValue *subscript) const {
+    for (int j{0}; j < raw_.rank; ++j) {
+      subscript[j] = GetDimension(j).LowerBound();
+    }
+  }
+
+  void IncrementSubscripts(
+      SubscriptValue *subscript, const int *permutation = nullptr) const {
+    for (int j{0}; j < raw_.rank; ++j) {
+      int k{permutation ? permutation[j] : j};
+      const Dimension &dim{GetDimension(k)};
+      if (subscript[k]++ < dim.UpperBound()) {
+        break;
+      }
+      subscript[k] = dim.LowerBound();
+    }
+  }
+
   DescriptorAddendum *Addendum() {
     if (raw_.f18Addendum != 0) {
       return reinterpret_cast<DescriptorAddendum *>(&GetDimension(rank()));
@@ -199,29 +242,36 @@ public:
     }
     return bytes;
   }
+
   std::size_t SizeInBytes() const;
 
+  std::size_t Elements() const;
+
+  bool IsContiguous() const {
+    if (raw_.attribute == CFI_attribute_allocatable) {
+      return true;
+    }
+    if (const DescriptorAddendum * addendum{Addendum()}) {
+      return (addendum->flags() & DescriptorAddendum::AllContiguous) != 0;
+    }
+    return false;
+  }
+
   void Check() const;
 
   // TODO: creation of array sections
 
-  template<typename A> A &Element(std::size_t offset = 0) const {
-    auto p = reinterpret_cast<char *>(raw_.base_addr);
-    return *reinterpret_cast<A *>(p + offset);
-  }
-
 private:
   ISO::CFI_cdesc_t raw_;
 };
 static_assert(sizeof(Descriptor) == sizeof(ISO::CFI_cdesc_t));
 
 // Properly configured instances of StaticDescriptor will occupy the
-// exact amount of storage required for the descriptor based on its
+// exact amount of storage required for the descriptor, its dimensional
-// number of dimensions and whether it requires an addendum.  To build
+// information, and possible addendum.  To build such a static descriptor,
-// such a static descriptor, declare an instance of StaticDescriptor<>,
+// declare an instance of StaticDescriptor<>, extract a reference to its
-// extract a reference to the Descriptor via the descriptor() accessor,
+// descriptor via the descriptor() accessor, and then built a Descriptor
-// and then built a Descriptor therein via descriptor.Establish().
+// therein via descriptor.Establish(), e.g.:
-// e.g.:
 //   StaticDescriptor<R,A,LP> statDesc;
 //   Descriptor &descriptor{statDesc.descriptor()};
 //   descriptor.Establish( ... );
@@ -240,9 +290,10 @@ public:
   }
 
   void Check() {
-    assert(descriptor().SizeInBytes() <= byteSize);
     assert(descriptor().rank() <= maxRank);
+    assert(descriptor().SizeInBytes() <= byteSize);
     if (DescriptorAddendum * addendum{descriptor().Addendum()}) {
+      assert(hasAddendum);
       if (const DerivedType * dt{addendum->derivedType()}) {
         assert(dt->lenParameters() <= maxLengthTypeParameters);
       } else {
@@ -252,6 +303,7 @@ public:
       assert(!hasAddendum);
       assert(maxLengthTypeParameters == 0);
     }
+    descriptor().Check();
   }
 
 private:

flang/runtime/transformational.cc

@@ -0,0 +1,150 @@
+// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "descriptor.h"
+#include "../lib/common/idioms.h"
+#include "../lib/evaluate/integer.h"
+#include <algorithm>
+#include <bitset>
+#include <cinttypes>
+#include <cstdlib>
+
+namespace Fortran::runtime {
+
+template<int BITS> inline std::int64_t LoadInt64(const char *p) {
+  using Int = const evaluate::value::Integer<BITS>;
+  Int *ip{reinterpret_cast<Int *>(p)};
+  return ip->ToInt64();
+}
+
+static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
+  switch (bytes) {
+  case 1: return LoadInt64<8>(p);
+  case 2: return LoadInt64<16>(p);
+  case 4: return LoadInt64<32>(p);
+  case 8: return LoadInt64<64>(p);
+  default: CRASH_NO_CASE;
+  }
+}
+
+// F2018 16.9.163
+Descriptor *RESHAPE(const Descriptor &source, const Descriptor &shape,
+    const Descriptor *pad, const Descriptor *order) {
+  // Compute and check the rank of the result.
+  CHECK(shape.rank() == 1);
+  CHECK(shape.type().IsInteger());
+  SubscriptValue resultRank{shape.GetDimension(0).Extent()};
+  CHECK(resultRank >= 0 && resultRank <= static_cast<SubscriptValue>(maxRank));
+
+  // Extract and check the shape of the result; compute its element count.
+  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) {
+    resultExtent[j] =
+        GetInt64(shape.Element<char>(&shapeSubscript), shapeElementBytes);
+    CHECK(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 sourceElements{source.Elements()};
+  std::size_t padElements{pad ? pad->Elements() : 0};
+  if (resultElements < sourceElements) {
+    CHECK(padElements > 0);
+    CHECK(pad->ElementBytes() == source.ElementBytes());
+  }
+
+  // Extract and check the optional ORDER= argument, which must be a
+  // permutation of [1..resultRank].
+  int dimOrder[maxRank];
+  if (order != nullptr) {
+    CHECK(order->rank() == 1);
+    CHECK(order->type().IsInteger());
+    CHECK(order->GetDimension(0).Extent() == resultRank);
+    std::bitset<maxRank> values;
+    SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()};
+    for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) {
+      auto k{GetInt64(order->Element<char>(orderSubscript), shapeElementBytes)};
+      CHECK(k >= 1 && k <= resultRank && !values.test(k - 1));
+      values.set(k - 1);
+      dimOrder[k - 1] = j;
+    }
+  } else {
+    for (int j{0}; j < resultRank; ++j) {
+      dimOrder[j] = j;
+    }
+  }
+
+  // Allocate the result's data storage.
+  std::size_t elementBytes{source.ElementBytes()};
+  std::size_t resultBytes{resultElements * elementBytes};
+  void *data{std::malloc(resultBytes)};
+  CHECK(resultBytes == 0 || data != nullptr);
+
+  // Create and populate the result's descriptor.
+  const DescriptorAddendum *sourceAddendum{source.Addendum()};
+  const DerivedType *sourceDerivedType{
+      sourceAddendum ? sourceAddendum->derivedType() : nullptr};
+  Descriptor *result{nullptr};
+  if (sourceDerivedType != nullptr) {
+    result =
+        Descriptor::Create(*sourceDerivedType, data, resultRank, resultExtent);
+  } else {
+    result = Descriptor::Create(
+        source.type(), elementBytes, data, resultRank, resultExtent);
+  }
+  DescriptorAddendum *resultAddendum{result->Addendum()};
+  CHECK(resultAddendum != nullptr);
+  resultAddendum->flags() |= DescriptorAddendum::DoNotFinalize;
+  resultAddendum->flags() |= DescriptorAddendum::AllContiguous;
+  if (sourceDerivedType != nullptr) {
+    std::size_t lenParameters{sourceDerivedType->lenParameters()};
+    for (std::size_t j{0}; j < lenParameters; ++j) {
+      resultAddendum->SetLenParameterValue(
+          j, sourceAddendum->LenParameterValue(j));
+    }
+  }
+
+  // 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);
+    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);
+      pad->IncrementSubscripts(padSubscript);
+      result->IncrementSubscripts(resultSubscript, dimOrder);
+    }
+  }
+
+  return result;
+}
+
+}  // namespace Fortran::runtime

flang/runtime/transformational.h

@@ -0,0 +1,26 @@
+// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#ifndef FORTRAN_RUNTIME_TRANSFORMATIONAL_H_
+#define FORTRAN_RUNTIME_TRANSFORMATIONAL_H_
+
+#include "descriptor.h"
+
+namespace Fortran::runtime {
+
+Descriptor *RESHAPE(const Descriptor &source, const Descriptor &shape,
+    const Descriptor *pad = nullptr, const Descriptor *order = nullptr);
+
+}  // namespace Fortran::runtime
+#endif  // FORTRAN_RUNTIME_TRANSFORMATIONAL_H_

flang/runtime/type-code.cc

@@ -59,5 +59,4 @@ TypeCode::TypeCode(TypeCategory f, int kind) {
   case TypeCategory::Derived: raw_ = CFI_type_struct; break;
   }
 }
-
 }  // namespace Fortran::runtime

flang/test/evaluate/CMakeLists.txt

@@ -73,9 +73,20 @@ target_link_libraries(expression-test
   FortranParser
 )
 
+add_executable(reshape-test
+  reshape.cc
+)
+
+target_link_libraries(reshape-test
+  FortranEvaluate
+  FortranEvaluateTesting
+  FortranRuntime
+)
+
 add_test(NAME Expression COMMAND expression-test)
 add_test(NAME Leadz COMMAND leading-zero-bit-count-test)
 add_test(NAME PopPar COMMAND bit-population-count-test)
 add_test(NAME Integer COMMAND integer-test)
 add_test(NAME Logical COMMAND logical-test)
 add_test(NAME Real COMMAND real-test)
+add_test(NAME RESHAPE COMMAND reshape-test)

flang/test/evaluate/reshape.cc

@@ -0,0 +1,84 @@
+// Copyright (c) 2018, NVIDIA CORPORATION.  All rights reserved.
+//
+// Licensed under the Apache License, Version 2.0 (the "License");
+// you may not use this file except in compliance with the License.
+// You may obtain a copy of the License at
+//
+//     http://www.apache.org/licenses/LICENSE-2.0
+//
+// Unless required by applicable law or agreed to in writing, software
+// distributed under the License is distributed on an "AS IS" BASIS,
+// WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+// See the License for the specific language governing permissions and
+// limitations under the License.
+
+#include "testing.h"
+#include "../../runtime/descriptor.h"
+#include "../../runtime/transformational.h"
+#include <cinttypes>
+
+using namespace Fortran::common;
+using namespace Fortran::runtime;
+
+int main() {
+  std::size_t dataElements{24};
+  std::int32_t *data{new std::int32_t[dataElements]};
+  for (std::size_t j{0}; j < dataElements; ++j) {
+    data[j] = j;
+  }
+
+  static const SubscriptValue sourceExtent[]{2, 3, 4};
+  Descriptor *source{Descriptor::Create(TypeCategory::Integer, sizeof data[0],
+      reinterpret_cast<void *>(data), 3, sourceExtent,
+      CFI_attribute_allocatable)};
+  source->Check();
+  MATCH(3, source->rank());
+  MATCH(2, source->GetDimension(0).Extent());
+  MATCH(3, source->GetDimension(1).Extent());
+  MATCH(4, source->GetDimension(2).Extent());
+
+  static const std::int16_t shapeData[]{8, 4};
+  static const SubscriptValue shapeExtent{2};
+  Descriptor *shape{Descriptor::Create(TypeCategory::Integer,
+      static_cast<int>(sizeof shapeData[0]),
+      const_cast<void *>(reinterpret_cast<const void *>(shapeData)), 1,
+      &shapeExtent)};
+  shape->Check();
+  MATCH(1, shape->rank());
+  MATCH(2, shape->GetDimension(0).Extent());
+
+  StaticDescriptor<3> padDescriptor;
+  static const std::int32_t padData[]{24, 25, 26, 27, 28, 29, 30, 31};
+  static const SubscriptValue padExtent[]{2, 2, 3};
+  padDescriptor.descriptor().Establish(TypeCategory::Integer,
+      static_cast<int>(sizeof padData[0]),
+      const_cast<void *>(reinterpret_cast<const void *>(padData)), 3,
+      padExtent);
+  padDescriptor.Check();
+
+  Descriptor *result{RESHAPE(*source, *shape, &padDescriptor.descriptor())};
+
+  TEST(result != 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->Element<std::int32_t>(j * sizeof(std::int32_t)));
+  }
+  for (std::int32_t j{0}; j < 32; ++j) {
+    SubscriptValue ss[2]{1 + (j % 8), 1 + (j / 8)};
+    MATCH(j, *result->Element<std::int32_t>(ss));
+  }
+
+  // TODO: test ORDER=
+
+  // Plug leaks; should run cleanly beneath valgrind
+  free(result->raw().base_addr);
+  result->Destroy();
+  shape->Destroy();
+  source->Destroy();
+  delete[] data;
+
+  return testing::Complete();
+}