maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

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

Original-commit: flang-compiler/f18@80257ee0d2
Reviewed-on: https://github.com/flang-compiler/f18/pull/162
Tree-same-pre-rewrite: false
This commit is contained in:
peter klausler 2018-08-02 11:45:11 -07:00
parent 6f9fa21d50
commit a8fed82258
14 changed files with 404 additions and 61 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
flang/include/flang/ISO_Fortran_binding.h
View File

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

2
flang/lib/evaluate/integer.h
View File

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

4
flang/lib/parser/basic-parsers.h
View File

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

5
flang/runtime/CMakeLists.txt
View File

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

5
flang/runtime/ISO_Fortran_binding.cc
View File

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

2
flang/runtime/derived-type.cc
View File

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

23
flang/runtime/derived-type.h
View File

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

58
flang/runtime/descriptor.cc
View File

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

92
flang/runtime/descriptor.h
View File

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

150
flang/runtime/transformational.cc Normal file
View File

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

26
flang/runtime/transformational.h Normal file
View File

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

1
flang/runtime/type-code.cc
View File

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

11
flang/test/evaluate/CMakeLists.txt
View File

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

84
flang/test/evaluate/reshape.cc Normal file
View File

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