1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
|
#include <stdlib.h>
#include <stdint.h>
#include <stdio.h>
#include <string.h>
#include <ISO_Fortran_binding.h>
#include "dump-descriptors.h"
struct s {
int i;
double d;
};
/* External entry point. */
extern void ctest (void);
void
ctest (void)
{
CFI_CDESC_T(3) desc;
CFI_cdesc_t *dv = (CFI_cdesc_t *) &desc;
CFI_index_t ex[3], lb[3], ub[3];
CFI_index_t sm;
int i;
/* Allocate and deallocate a scalar. */
sm = sizeof (struct s);
check_CFI_status ("CFI_establish",
CFI_establish (dv, NULL, CFI_attribute_allocatable,
CFI_type_struct, sm,
0, NULL));
check_CFI_status ("CFI_allocate",
CFI_allocate (dv, NULL, NULL, 69));
dump_CFI_cdesc_t (dv);
if (dv->base_addr == NULL)
abort ();
/* The elem_len argument only overrides the initial value in the
descriptor for character types. */
if (dv->elem_len != sm)
abort ();
check_CFI_status ("CFI_deallocate",
CFI_deallocate (dv));
/* The base_addr member of the C descriptor becomes a null pointer. */
if (dv->base_addr != NULL)
abort ();
/* Try an array. We are going to test the requirement that:
The supplied lower and upper bounds override any current
dimension information in the C descriptor.
so we'll stuff different values in the descriptor to start with. */
ex[0] = 3;
ex[1] = 4;
ex[2] = 5;
check_CFI_status ("CFI_establish",
CFI_establish (dv, NULL, CFI_attribute_pointer,
CFI_type_double, 0, 3, ex));
lb[0] = 1;
lb[1] = 2;
lb[2] = 3;
ub[0] = 10;
ub[1] = 5;
ub[2] = 10;
sm = sizeof (double);
check_CFI_status ("CFI_allocate",
CFI_allocate (dv, lb, ub, 20));
dump_CFI_cdesc_t (dv);
if (dv->base_addr == NULL)
abort ();
/* The element sizes passed to both CFI_establish and CFI_allocate should
have been ignored in favor of using the constant size of the type. */
if (dv->elem_len != sm)
abort ();
/* Check extents and strides; we expect the allocated array to
be contiguous so the stride computation should be straightforward
no matter what the lower bound is. */
for (i = 0; i < 3; i++)
{
CFI_index_t extent = ub[i] - lb[i] + 1;
if (dv->dim[i].lower_bound != lb[i])
abort ();
if (dv->dim[i].extent != extent)
abort ();
/* pr93524 */
if (dv->dim[i].sm != sm)
abort ();
sm *= extent;
}
check_CFI_status ("CFI_deallocate",
CFI_deallocate (dv));
if (dv->base_addr != NULL)
abort ();
/* Similarly for a character array, except that we expect the
elem_len provided to CFI_allocate to prevail. We set the elem_len
to the same size as the array element in the previous example, so
the bounds and strides should all be the same. */
ex[0] = 3;
ex[1] = 4;
ex[2] = 5;
check_CFI_status ("CFI_establish",
CFI_establish (dv, NULL, CFI_attribute_allocatable,
CFI_type_char, 4, 3, ex));
lb[0] = 1;
lb[1] = 2;
lb[2] = 3;
ub[0] = 10;
ub[1] = 5;
ub[2] = 10;
sm = sizeof (double);
check_CFI_status ("CFI_allocate",
CFI_allocate (dv, lb, ub, sm));
dump_CFI_cdesc_t (dv);
if (dv->base_addr == NULL)
abort ();
if (dv->elem_len != sm)
abort ();
/* Check extents and strides; we expect the allocated array to
be contiguous so the stride computation should be straightforward
no matter what the lower bound is. */
for (i = 0; i < 3; i++)
{
CFI_index_t extent = ub[i] - lb[i] + 1;
if (dv->dim[i].lower_bound != lb[i])
abort ();
if (dv->dim[i].extent != extent)
abort ();
/* pr93524 */
if (dv->dim[i].sm != sm)
abort ();
sm *= extent;
}
check_CFI_status ("CFI_deallocate",
CFI_deallocate (dv));
if (dv->base_addr != NULL)
abort ();
/* Signed char is not a Fortran character type. Here we expect it to
ignore the elem_len argument and use the size of the type. */
ex[0] = 3;
ex[1] = 4;
ex[2] = 5;
check_CFI_status ("CFI_establish",
CFI_establish (dv, NULL, CFI_attribute_allocatable,
CFI_type_signed_char, 4, 3, ex));
lb[0] = 1;
lb[1] = 2;
lb[2] = 3;
ub[0] = 10;
ub[1] = 5;
ub[2] = 10;
sm = sizeof (double);
check_CFI_status ("CFI_allocate",
CFI_allocate (dv, lb, ub, sm));
dump_CFI_cdesc_t (dv);
if (dv->base_addr == NULL)
abort ();
if (dv->elem_len != sizeof (signed char))
abort ();
check_CFI_status ("CFI_deallocate",
CFI_deallocate (dv));
if (dv->base_addr != NULL)
abort ();
}
|
