107 lines
4 KiB
C++
107 lines
4 KiB
C++
//===-- flang/unittests/Runtime/Pointer.cpp--------- -------------*- 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
|
|
//
|
|
//===----------------------------------------------------------------------===//
|
|
|
|
#include "flang/Runtime/pointer.h"
|
|
#include "gtest/gtest.h"
|
|
#include "tools.h"
|
|
#include "flang/Runtime/descriptor.h"
|
|
|
|
using namespace Fortran::runtime;
|
|
|
|
TEST(Pointer, BasicAllocateDeallocate) {
|
|
// REAL(4), POINTER :: p(:)
|
|
auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
|
|
nullptr, 1, nullptr, CFI_attribute_pointer)};
|
|
// ALLOCATE(p(2:11))
|
|
RTNAME(PointerSetBounds)(*p, 0, 2, 11);
|
|
RTNAME(PointerAllocate)
|
|
(*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));
|
|
EXPECT_EQ(p->Elements(), 10u);
|
|
EXPECT_EQ(p->GetDimension(0).LowerBound(), 2);
|
|
EXPECT_EQ(p->GetDimension(0).UpperBound(), 11);
|
|
// DEALLOCATE(p)
|
|
RTNAME(PointerDeallocate)
|
|
(*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
EXPECT_FALSE(RTNAME(PointerIsAssociated)(*p));
|
|
}
|
|
|
|
TEST(Pointer, ApplyMoldAllocation) {
|
|
// REAL(4), POINTER :: p
|
|
auto m{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
|
|
nullptr, 0, nullptr, CFI_attribute_pointer)};
|
|
RTNAME(PointerAllocate)
|
|
(*m, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
|
|
// CLASS(*), POINTER :: p
|
|
auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
|
|
nullptr, 0, nullptr, CFI_attribute_pointer)};
|
|
p->raw().elem_len = 0;
|
|
p->raw().type = CFI_type_other;
|
|
|
|
RTNAME(PointerApplyMold)(*p, *m);
|
|
RTNAME(PointerAllocate)
|
|
(*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
|
|
EXPECT_EQ(p->ElementBytes(), m->ElementBytes());
|
|
EXPECT_EQ(p->type(), m->type());
|
|
}
|
|
|
|
TEST(Pointer, DeallocatePolymorphic) {
|
|
// CLASS(*) :: p
|
|
// ALLOCATE(integer::p)
|
|
auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Integer, 4},
|
|
4, nullptr, 0, nullptr, CFI_attribute_pointer)};
|
|
RTNAME(PointerAllocate)
|
|
(*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
// DEALLOCATE(p)
|
|
RTNAME(PointerDeallocatePolymorphic)
|
|
(*p, nullptr, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
}
|
|
|
|
TEST(Pointer, AllocateFromScalarSource) {
|
|
// REAL(4), POINTER :: p(:)
|
|
auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
|
|
nullptr, 1, nullptr, CFI_attribute_pointer)};
|
|
// ALLOCATE(p(2:11), SOURCE=3.4)
|
|
float sourecStorage{3.4F};
|
|
auto s{Descriptor::Create(Fortran::common::TypeCategory::Real, 4,
|
|
reinterpret_cast<void *>(&sourecStorage), 0, nullptr,
|
|
CFI_attribute_pointer)};
|
|
RTNAME(PointerSetBounds)(*p, 0, 2, 11);
|
|
RTNAME(PointerAllocateSource)
|
|
(*p, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));
|
|
EXPECT_EQ(p->Elements(), 10u);
|
|
EXPECT_EQ(p->GetDimension(0).LowerBound(), 2);
|
|
EXPECT_EQ(p->GetDimension(0).UpperBound(), 11);
|
|
EXPECT_EQ(*p->OffsetElement<float>(), 3.4F);
|
|
p->Destroy();
|
|
}
|
|
|
|
TEST(Pointer, AllocateSourceZeroSize) {
|
|
using Fortran::common::TypeCategory;
|
|
// REAL(4), POINTER :: p(:)
|
|
auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,
|
|
nullptr, 1, nullptr, CFI_attribute_pointer)};
|
|
// REAL(4) :: s(-1:-2) = 0.
|
|
float sourecStorage{0.F};
|
|
const SubscriptValue extents[1]{0};
|
|
auto s{Descriptor::Create(TypeCategory::Real, 4,
|
|
reinterpret_cast<void *>(&sourecStorage), 1, extents,
|
|
CFI_attribute_other)};
|
|
// ALLOCATE(p, SOURCE=s)
|
|
RTNAME(PointerSetBounds)(*p, 0, -1, -2);
|
|
RTNAME(PointerAllocateSource)
|
|
(*p, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);
|
|
EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));
|
|
EXPECT_EQ(p->Elements(), 0u);
|
|
EXPECT_EQ(p->GetDimension(0).LowerBound(), 1);
|
|
EXPECT_EQ(p->GetDimension(0).UpperBound(), 0);
|
|
p->Destroy();
|
|
}
|