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