! 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
! 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
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
allocatable.cpp
buffer.cpp
complex-reduction.c
+ copy.cpp
character.cpp
connection.cpp
derived.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.
--- /dev/null
+//===-- 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
--- /dev/null
+//===-- 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_
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)
terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind);
}
}
-
} // namespace Fortran::runtime
}
}
-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 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);
}
}
}
return std::nullopt;
}
-
} // namespace Fortran::runtime
#endif // FORTRAN_RUNTIME_TOOLS_H_
//
//===----------------------------------------------------------------------===//
+// 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()};
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];
}
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;
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);
}
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
//
//===----------------------------------------------------------------------===//
+// 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 "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_
// 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
// 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};
// 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();
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
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());
CharacterTest.cpp
CrashHandlerFixture.cpp
Format.cpp
+ ListInputTest.cpp
Matmul.cpp
MiscIntrinsic.cpp
Namelist.cpp
Random.cpp
Reduction.cpp
RuntimeCrashTest.cpp
- ListInputTest.cpp
+ Transformational.cpp
)
target_link_libraries(FlangRuntimeTests
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__);
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,
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);
-//===-- 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.
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);
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,
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(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);
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()};
--- /dev/null
+//===-- 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();
+}
projects / platform / upstream / llvm.git / commitdiff