forked from OSchip/llvm-project
[flang] Implement more transformational intrinsic functions in runtime
Define APIs, naively implement, and add basic sanity unit tests for the transformational intrinsic functions CSHIFT, EOSHIFT, PACK, SPREAD, TRANSPOSE, and UNPACK. These are the remaining transformational intrinsic functions that rearrange data without regard to type (except for default boundary values in EOSHIFT); RESHAPE was already in place as a stress test for the runtime's descriptor handling facilities. Code is in place to create copies of allocatable/automatic components when transforming arrays of derived type, but it won't do anything until we have derived type information being passed to the runtime from the frontend. Differential Revision: https://reviews.llvm.org/D102857
This commit is contained in:
peter klausler
parent
e3cf7c88c4
commit
c1db35f0c2
|
|
@ -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
|
||||
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@ add_flang_library(FortranRuntime
|
|||
allocatable.cpp
|
||||
buffer.cpp
|
||||
complex-reduction.c
|
||||
copy.cpp
|
||||
character.cpp
|
||||
connection.cpp
|
||||
derived.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.
|
||||
|
|
|
|||
|
|
@ -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 <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
|
||||
|
|
@ -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_
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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<const CppTypeFor<TypeCategory::Integer, 1> *>(p);
|
||||
|
|
@ -77,8 +78,7 @@ static inline std::int64_t GetInt64(const char *p, std::size_t bytes) {
|
|||
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);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
@ -333,6 +333,5 @@ std::optional<std::pair<TypeCategory, int>> inline constexpr GetResultType(
|
|||
}
|
||||
return std::nullopt;
|
||||
}
|
||||
|
||||
} // namespace Fortran::runtime
|
||||
#endif // FORTRAN_RUNTIME_TOOLS_H_
|
||||
|
|
|
|||
|
|
@ -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 <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()};
|
||||
|
|
@ -33,8 +371,8 @@ OwningPtr<Descriptor> 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<char>(&shapeSubscript), shapeElementBytes);
|
||||
resultExtent[j] = GetInt64(
|
||||
shape.Element<char>(&shapeSubscript), shapeElementBytes, terminator);
|
||||
RUNTIME_CHECK(terminator, resultExtent[j] >= 0);
|
||||
resultElements *= resultExtent[j];
|
||||
}
|
||||
|
|
@ -59,8 +397,8 @@ OwningPtr<Descriptor> 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<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;
|
||||
|
|
@ -109,8 +447,7 @@ OwningPtr<Descriptor> 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<void>(resultSubscript),
|
||||
source.Element<const void>(sourceSubscript), elementBytes);
|
||||
CopyElement(*result, resultSubscript, source, sourceSubscript, terminator);
|
||||
source.IncrementSubscripts(sourceSubscript);
|
||||
result->IncrementSubscripts(resultSubscript, dimOrder);
|
||||
}
|
||||
|
|
@ -119,8 +456,7 @@ OwningPtr<Descriptor> RTNAME(Reshape)(const Descriptor &source,
|
|||
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);
|
||||
}
|
||||
|
|
@ -128,4 +464,94 @@ OwningPtr<Descriptor> 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<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
|
||||
|
|
|
|||
|
|
@ -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<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_
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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());
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -27,7 +27,7 @@ TEST(Matmul, Basic) {
|
|||
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__);
|
||||
|
|
|
|||
|
|
@ -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);
|
||||
|
|
|
|||
|
|
@ -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<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);
|
||||
|
|
@ -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<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);
|
||||
|
|
@ -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<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()};
|
||||
|
|
|
|||
|
|
@ -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<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();
|
||||
}
|
||||
Loading…
Reference in New Issue