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 */
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;
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.
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.
ISO_Fortran_binding.cc
derived-type.cc
descriptor.cc
+ transformational.cc
type-code.cc
)
+
+target_link_libraries(FortranRuntime
+ FortranEvaluate
+)
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;
}
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;
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;
}
// 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},
}
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};
// 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];
}
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};
// limitations under the License.
#include "descriptor.h"
+#include "../lib/common/idioms.h"
#include <cassert>
#include <cstdlib>
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;
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;
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;
void Descriptor::Destroy() {
if (const DescriptorAddendum * addendum{Addendum()}) {
if (addendum->flags() & DescriptorAddendum::Created) {
- delete[] reinterpret_cast<char *>(this);
+ std::free(reinterpret_cast<void *>(this));
}
}
}
(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
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) +
~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);
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_; }
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()));
}
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( ... );
}
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 {
assert(!hasAddendum);
assert(maxLengthTypeParameters == 0);
}
+ descriptor().Check();
}
private:
--- /dev/null
+// 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
--- /dev/null
+// 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_
case TypeCategory::Derived: raw_ = CFI_type_struct; break;
}
}
-
} // namespace Fortran::runtime
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)
--- /dev/null
+// 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();
+}
projects / platform / upstream / llvm.git / commitdiff