diff --git a/flang/module/__fortran_type_info.f90 b/flang/module/__fortran_type_info.f90 index 6fce352c162e..c2a9ed16e10b 100644 --- a/flang/module/__fortran_type_info.f90 +++ b/flang/module/__fortran_type_info.f90 @@ -30,7 +30,7 @@ module __Fortran_type_info ! 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 @@ -38,14 +38,14 @@ module __Fortran_type_info ! 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 @@ -86,8 +86,8 @@ module __Fortran_type_info 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 diff --git a/flang/runtime/CMakeLists.txt b/flang/runtime/CMakeLists.txt index a484c94b0da1..7d5c88e78825 100644 --- a/flang/runtime/CMakeLists.txt +++ b/flang/runtime/CMakeLists.txt @@ -35,6 +35,7 @@ add_flang_library(FortranRuntime allocatable.cpp buffer.cpp complex-reduction.c + copy.cpp character.cpp connection.cpp derived.cpp diff --git a/flang/runtime/allocatable.cpp b/flang/runtime/allocatable.cpp index addc1b78d5d1..f14122948f5e 100644 --- a/flang/runtime/allocatable.cpp +++ b/flang/runtime/allocatable.cpp @@ -1,4 +1,4 @@ -//===-- 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. diff --git a/flang/runtime/copy.cpp b/flang/runtime/copy.cpp new file mode 100644 index 000000000000..458b8f0a16da --- /dev/null +++ b/flang/runtime/copy.cpp @@ -0,0 +1,64 @@ +//===-- 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 + +namespace Fortran::runtime { + +void CopyElement(const Descriptor &to, const SubscriptValue toAt[], + const Descriptor &from, const SubscriptValue fromAt[], + Terminator &terminator) { + char *toPtr{to.Element(toAt)}; + const char *fromPtr{from.Element(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()}; + 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(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( + 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 diff --git a/flang/runtime/copy.h b/flang/runtime/copy.h new file mode 100644 index 000000000000..6de445586840 --- /dev/null +++ b/flang/runtime/copy.h @@ -0,0 +1,28 @@ +//===-- 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_ diff --git a/flang/runtime/descriptor.h b/flang/runtime/descriptor.h index d86c136faff3..5e03ad05b253 100644 --- a/flang/runtime/descriptor.h +++ b/flang/runtime/descriptor.h @@ -246,10 +246,18 @@ public: 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) diff --git a/flang/runtime/tools.cpp b/flang/runtime/tools.cpp index 2d036f54e8f3..c67da77e0c11 100644 --- a/flang/runtime/tools.cpp +++ b/flang/runtime/tools.cpp @@ -106,5 +106,4 @@ void CheckIntegerKind(Terminator &terminator, int kind, const char *intrinsic) { terminator.Crash("%s: bad KIND=%d argument", intrinsic, kind); } } - } // namespace Fortran::runtime diff --git a/flang/runtime/tools.h b/flang/runtime/tools.h index ee8c439b6cb5..d4a070868abc 100644 --- a/flang/runtime/tools.h +++ b/flang/runtime/tools.h @@ -66,7 +66,8 @@ inline void PutContiguousConverted(TO *to, FROM *from, std::size_t count) { } } -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 *>(p); @@ -77,8 +78,7 @@ static inline std::int64_t GetInt64(const char *p, std::size_t bytes) { case 8: return *reinterpret_cast *>(p); default: - Terminator{__FILE__, __LINE__}.Crash( - "GetInt64: no case for %zd bytes", bytes); + terminator.Crash("GetInt64: no case for %zd bytes", bytes); } } @@ -333,6 +333,5 @@ std::optional> inline constexpr GetResultType( } return std::nullopt; } - } // namespace Fortran::runtime #endif // FORTRAN_RUNTIME_TOOLS_H_ diff --git a/flang/runtime/transformational.cpp b/flang/runtime/transformational.cpp index 07a34c198da1..e7cd089399f5 100644 --- a/flang/runtime/transformational.cpp +++ b/flang/runtime/transformational.cpp @@ -6,19 +6,357 @@ // //===----------------------------------------------------------------------===// +// 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 -#include 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(), 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(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(), bytes, ' '); + break; + case 2: + std::fill_n(result.OffsetElement(), bytes / 2, + static_cast(' ')); + break; + case 4: + std::fill_n(result.OffsetElement(), bytes / 4, + static_cast(' ')); + 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 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 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()}; @@ -33,8 +371,8 @@ OwningPtr RTNAME(Reshape)(const Descriptor &source, SubscriptValue shapeSubscript{shape.GetDimension(0).LowerBound()}; for (SubscriptValue j{0}; j < resultRank; ++j, ++shapeSubscript) { lowerBound[j] = 1; - resultExtent[j] = - GetInt64(shape.Element(&shapeSubscript), shapeElementBytes); + resultExtent[j] = GetInt64( + shape.Element(&shapeSubscript), shapeElementBytes, terminator); RUNTIME_CHECK(terminator, resultExtent[j] >= 0); resultElements *= resultExtent[j]; } @@ -59,8 +397,8 @@ OwningPtr RTNAME(Reshape)(const Descriptor &source, std::uint64_t values{0}; SubscriptValue orderSubscript{order->GetDimension(0).LowerBound()}; for (SubscriptValue j{0}; j < resultRank; ++j, ++orderSubscript) { - auto k{GetInt64( - order->OffsetElement(orderSubscript), shapeElementBytes)}; + auto k{GetInt64(order->OffsetElement(orderSubscript), + shapeElementBytes, terminator)}; RUNTIME_CHECK( terminator, k >= 1 && k <= resultRank && !((values >> k) & 1)); values |= std::uint64_t{1} << k; @@ -109,8 +447,7 @@ OwningPtr RTNAME(Reshape)(const Descriptor &source, std::size_t resultElement{0}; std::size_t elementsFromSource{std::min(resultElements, sourceElements)}; for (; resultElement < elementsFromSource; ++resultElement) { - std::memcpy(result->Element(resultSubscript), - source.Element(sourceSubscript), elementBytes); + CopyElement(*result, resultSubscript, source, sourceSubscript, terminator); source.IncrementSubscripts(sourceSubscript); result->IncrementSubscripts(resultSubscript, dimOrder); } @@ -119,8 +456,7 @@ OwningPtr RTNAME(Reshape)(const Descriptor &source, SubscriptValue padSubscript[maxRank]; pad->GetLowerBounds(padSubscript); for (; resultElement < resultElements; ++resultElement) { - std::memcpy(result->Element(resultSubscript), - pad->Element(padSubscript), elementBytes); + CopyElement(*result, resultSubscript, *pad, padSubscript, terminator); pad->IncrementSubscripts(padSubscript); result->IncrementSubscripts(resultSubscript, dimOrder); } @@ -128,4 +464,94 @@ OwningPtr RTNAME(Reshape)(const Descriptor &source, 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(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 diff --git a/flang/runtime/transformational.h b/flang/runtime/transformational.h index 1994fca58235..85d2ae5e8e3b 100644 --- a/flang/runtime/transformational.h +++ b/flang/runtime/transformational.h @@ -6,6 +6,14 @@ // //===----------------------------------------------------------------------===// +// 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_ @@ -14,9 +22,41 @@ #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 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_ diff --git a/flang/runtime/type-info.h b/flang/runtime/type-info.h index 4f933e8bb5a5..c83a5f2f517e 100644 --- a/flang/runtime/type-info.h +++ b/flang/runtime/type-info.h @@ -27,12 +27,13 @@ public: // 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 @@ -40,7 +41,7 @@ public: // 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}; @@ -52,14 +53,16 @@ public: // 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(); @@ -95,8 +98,10 @@ struct Component { 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 diff --git a/flang/unittests/Evaluate/reshape.cpp b/flang/unittests/Evaluate/reshape.cpp index a51acdb5fca8..c3aa8f4b76bc 100644 --- a/flang/unittests/Evaluate/reshape.cpp +++ b/flang/unittests/Evaluate/reshape.cpp @@ -52,7 +52,8 @@ int main() { 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()); diff --git a/flang/unittests/RuntimeGTest/CMakeLists.txt b/flang/unittests/RuntimeGTest/CMakeLists.txt index 3d45cf6dc877..13bfadf66a52 100644 --- a/flang/unittests/RuntimeGTest/CMakeLists.txt +++ b/flang/unittests/RuntimeGTest/CMakeLists.txt @@ -2,6 +2,7 @@ add_flang_unittest(FlangRuntimeTests CharacterTest.cpp CrashHandlerFixture.cpp Format.cpp + ListInputTest.cpp Matmul.cpp MiscIntrinsic.cpp Namelist.cpp @@ -10,7 +11,7 @@ add_flang_unittest(FlangRuntimeTests Random.cpp Reduction.cpp RuntimeCrashTest.cpp - ListInputTest.cpp + Transformational.cpp ) target_link_libraries(FlangRuntimeTests diff --git a/flang/unittests/RuntimeGTest/Matmul.cpp b/flang/unittests/RuntimeGTest/Matmul.cpp index ae9e7a84236c..1f0c756bc5d7 100644 --- a/flang/unittests/RuntimeGTest/Matmul.cpp +++ b/flang/unittests/RuntimeGTest/Matmul.cpp @@ -27,7 +27,7 @@ TEST(Matmul, Basic) { std::vector{3, 2}, std::vector{6, 7, 8, 9, 10, 11})}; auto v{MakeArray( std::vector{2}, std::vector{-1, -2})}; - StaticDescriptor<2> statDesc; + StaticDescriptor<2, true> statDesc; Descriptor &result{statDesc.descriptor()}; RTNAME(Matmul)(result, *x, *y, __FILE__, __LINE__); diff --git a/flang/unittests/RuntimeGTest/Namelist.cpp b/flang/unittests/RuntimeGTest/Namelist.cpp index fc38cee47f86..77eec4e34132 100644 --- a/flang/unittests/RuntimeGTest/Namelist.cpp +++ b/flang/unittests/RuntimeGTest/Namelist.cpp @@ -34,7 +34,7 @@ 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, @@ -136,7 +136,7 @@ TEST(NamelistTests, Subscripts) { 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); diff --git a/flang/unittests/RuntimeGTest/Reduction.cpp b/flang/unittests/RuntimeGTest/Reduction.cpp index 5a2c6fb80b37..4c01cf468bcb 100644 --- a/flang/unittests/RuntimeGTest/Reduction.cpp +++ b/flang/unittests/RuntimeGTest/Reduction.cpp @@ -1,4 +1,4 @@ -//===-- 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. @@ -34,7 +34,7 @@ TEST(Reductions, DimMaskProductInt4) { shape, std::vector{1, 2, 3, 4, 5, 6})}; auto mask{MakeArray( shape, std::vector{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); @@ -66,7 +66,7 @@ TEST(Reductions, DoubleMaxMinNorm2) { 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, @@ -146,7 +146,7 @@ TEST(Reductions, Character) { std::vector shape{2, 3}; auto array{MakeArray(shape, std::vector{"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); @@ -245,7 +245,7 @@ TEST(Reductions, Logical) { 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); @@ -344,7 +344,7 @@ TEST(Reductions, FindlocNumeric) { std::numeric_limits::quiet_NaN(), std::numeric_limits::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()}; diff --git a/flang/unittests/RuntimeGTest/Transformational.cpp b/flang/unittests/RuntimeGTest/Transformational.cpp new file mode 100644 index 000000000000..00495fc04a94 --- /dev/null +++ b/flang/unittests/RuntimeGTest/Transformational.cpp @@ -0,0 +1,203 @@ +//===-- 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( + std::vector{2, 3}, std::vector{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( + std::vector{3}, std::vector{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(j), cshiftExpect1[j]); + } + result.Destroy(); + + auto shift2{MakeArray( + std::vector{2}, std::vector{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(j), cshiftExpect2[j]); + } + result.Destroy(); + + auto boundary{MakeArray( + std::vector{3}, std::vector{-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(j), eoshiftExpect1[j]); + } + result.Destroy(); +} + +TEST(Transformational, Pack) { + // ARRAY 1 3 5 + // 2 4 6 + auto array{MakeArray( + std::vector{2, 3}, std::vector{1, 2, 3, 4, 5, 6})}; + array->GetDimension(0).SetLowerBound(2); // shouldn't matter + array->GetDimension(1).SetLowerBound(-1); + auto mask{MakeArray(std::vector{2, 3}, + std::vector{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(j), packExpect1[j]) + << " at " << j; + } + result.Destroy(); + + auto vector{MakeArray( + std::vector{5}, std::vector{-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(j), packExpect2[j]) + << " at " << j; + } + result.Destroy(); +} + +TEST(Transformational, Spread) { + auto array{MakeArray( + std::vector{3}, std::vector{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(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(j), 1 + j % 3); + } + result.Destroy(); +} + +TEST(Transformational, Transpose) { + // ARRAY 1 3 5 + // 2 4 6 + auto array{MakeArray( + std::vector{2, 3}, std::vector{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(j), expect[j]); + } + result.Destroy(); +} + +TEST(Transformational, Unpack) { + auto vector{MakeArray( + std::vector{4}, std::vector{1, 2, 3, 4})}; + vector->GetDimension(0).SetLowerBound(2); // shouldn't matter + auto mask{MakeArray(std::vector{2, 3}, + std::vector{false, true, true, false, false, true})}; + mask->GetDimension(0).SetLowerBound(0); // shouldn't matter + mask->GetDimension(1).SetLowerBound(2); + auto field{MakeArray(std::vector{2, 3}, + std::vector{-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(j), expect[j]); + } + result.Destroy(); +}