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-exception
6//
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 :: p
36 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 :: p
42 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(*) :: p
57 // 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) => t
132 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

source code of flang-rt/unittests/Runtime/Pointer.cpp