152 lines · cpp
1//===-- unittests/Runtime/Pointer.cpp ---------------------------*- C++ -*-===//2//3// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions.4// See https://llvm.org/LICENSE.txt for license information.5// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception6//7//===----------------------------------------------------------------------===//8 9#include "flang/Runtime/pointer.h"10#include "tools.h"11#include "gtest/gtest.h"12#include "flang-rt/runtime/descriptor.h"13 14using namespace Fortran::runtime;15 16TEST(Pointer, BasicAllocateDeallocate) {17 // REAL(4), POINTER :: p(:)18 auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,19 nullptr, 1, nullptr, CFI_attribute_pointer)};20 // ALLOCATE(p(2:11))21 RTNAME(PointerSetBounds)(*p, 0, 2, 11);22 RTNAME(PointerAllocate)23 (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);24 EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));25 EXPECT_EQ(p->Elements(), 10u);26 EXPECT_EQ(p->GetDimension(0).LowerBound(), 2);27 EXPECT_EQ(p->GetDimension(0).UpperBound(), 11);28 // DEALLOCATE(p)29 RTNAME(PointerDeallocate)30 (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);31 EXPECT_FALSE(RTNAME(PointerIsAssociated)(*p));32}33 34TEST(Pointer, ApplyMoldAllocation) {35 // REAL(4), POINTER :: p36 auto m{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,37 nullptr, 0, nullptr, CFI_attribute_pointer)};38 RTNAME(PointerAllocate)39 (*m, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);40 41 // CLASS(*), POINTER :: p42 auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,43 nullptr, 0, nullptr, CFI_attribute_pointer)};44 p->raw().elem_len = 0;45 p->raw().type = CFI_type_other;46 47 RTNAME(PointerApplyMold)(*p, *m);48 RTNAME(PointerAllocate)49 (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);50 51 EXPECT_EQ(p->ElementBytes(), m->ElementBytes());52 EXPECT_EQ(p->type(), m->type());53}54 55TEST(Pointer, DeallocatePolymorphic) {56 // CLASS(*) :: p57 // ALLOCATE(integer::p)58 auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Integer, 4},59 4, nullptr, 0, nullptr, CFI_attribute_pointer)};60 RTNAME(PointerAllocate)61 (*p, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);62 // DEALLOCATE(p)63 RTNAME(PointerDeallocatePolymorphic)64 (*p, nullptr, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);65}66 67TEST(Pointer, AllocateFromScalarSource) {68 // REAL(4), POINTER :: p(:)69 auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,70 nullptr, 1, nullptr, CFI_attribute_pointer)};71 // ALLOCATE(p(2:11), SOURCE=3.4)72 float sourecStorage{3.4F};73 auto s{Descriptor::Create(Fortran::common::TypeCategory::Real, 4,74 reinterpret_cast<void *>(&sourecStorage), 0, nullptr,75 CFI_attribute_pointer)};76 RTNAME(PointerSetBounds)(*p, 0, 2, 11);77 RTNAME(PointerAllocateSource)78 (*p, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);79 EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));80 EXPECT_EQ(p->Elements(), 10u);81 EXPECT_EQ(p->GetDimension(0).LowerBound(), 2);82 EXPECT_EQ(p->GetDimension(0).UpperBound(), 11);83 EXPECT_EQ(*p->OffsetElement<float>(), 3.4F);84 p->Destroy();85}86 87TEST(Pointer, AllocateSourceZeroSize) {88 using Fortran::common::TypeCategory;89 // REAL(4), POINTER :: p(:)90 auto p{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,91 nullptr, 1, nullptr, CFI_attribute_pointer)};92 // REAL(4) :: s(-1:-2) = 0.93 float sourecStorage{0.F};94 const SubscriptValue extents[1]{0};95 auto s{Descriptor::Create(TypeCategory::Real, 4,96 reinterpret_cast<void *>(&sourecStorage), 1, extents,97 CFI_attribute_other)};98 // ALLOCATE(p, SOURCE=s)99 RTNAME(PointerSetBounds)(*p, 0, -1, -2);100 RTNAME(PointerAllocateSource)101 (*p, *s, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);102 EXPECT_TRUE(RTNAME(PointerIsAssociated)(*p));103 EXPECT_EQ(p->Elements(), 0u);104 EXPECT_EQ(p->GetDimension(0).LowerBound(), 1);105 EXPECT_EQ(p->GetDimension(0).UpperBound(), 0);106 p->Destroy();107}108 109TEST(Pointer, PointerAssociateRemapping) {110 using Fortran::common::TypeCategory;111 // REAL(4), POINTER :: p(:)112 StaticDescriptor<Fortran::common::maxRank, true> staticDesc;113 auto p{staticDesc.descriptor()};114 SubscriptValue extent[1]{1};115 p.Establish(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4, nullptr, 1,116 extent, CFI_attribute_pointer);117 std::size_t descSize{p.SizeInBytes()};118 EXPECT_LE(descSize, staticDesc.byteSize);119 // REAL(4), CONTIGUOUS, POINTER :: t(:,:,:)120 auto t{Descriptor::Create(TypeCode{Fortran::common::TypeCategory::Real, 4}, 4,121 nullptr, 3, nullptr, CFI_attribute_pointer)};122 RTNAME(PointerSetBounds)(*t, 0, 1, 1);123 RTNAME(PointerSetBounds)(*t, 1, 1, 1);124 RTNAME(PointerSetBounds)(*t, 2, 1, 1);125 RTNAME(PointerAllocate)(126 *t, /*hasStat=*/false, /*errMsg=*/nullptr, __FILE__, __LINE__);127 EXPECT_TRUE(RTNAME(PointerIsAssociated)(*t));128 // INTEGER(4) :: b(2,1) = [[1,1]]129 auto b{MakeArray<TypeCategory::Integer, 4>(130 std::vector<int>{2, 1}, std::vector<std::int32_t>{1, 1})};131 // p(1:1) => t132 RTNAME(PointerAssociateRemapping)(p, *t, *b, __FILE__, __LINE__);133 EXPECT_TRUE(RTNAME(PointerIsAssociated)(p));134 EXPECT_EQ(p.rank(), 1);135 EXPECT_EQ(p.Elements(), 1u);136 137 // Verify that the memory past the p's descriptor is not affected.138 const char *addr = reinterpret_cast<const char *>(&staticDesc);139 const char *ptr = addr + descSize;140 const char *end = addr + staticDesc.byteSize;141 while (ptr != end) {142 if (*ptr != '\0') {143 std::fprintf(stderr, "byte %zd after pointer descriptor was written\n",144 ptr - addr);145 EXPECT_EQ(*ptr, '\0');146 break;147 }148 ++ptr;149 }150 p.Destroy();151}152