1 #include <ISO_Fortran_binding.h>
2 #include <stdbool.h>
3 #include <string.h>
4
5 struct loc_t {
6 intptr_t x, y, z;
7 };
8
9 typedef struct loc_t (*ftn_fn) (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
10 struct loc_t char_assumed_size_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
11 struct loc_t char_assumed_size_in_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
12 struct loc_t char_expl_size_f (CFI_cdesc_t *,CFI_cdesc_t *, CFI_cdesc_t *, int, int);
13 struct loc_t char_expl_size_in_f (CFI_cdesc_t *,CFI_cdesc_t *, CFI_cdesc_t *, int, int);
14 struct loc_t char_assumed_rank_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
15 struct loc_t char_assumed_rank_in_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
16 struct loc_t char_assumed_rank_cont_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
17 struct loc_t char_assumed_rank_cont_in_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
18 struct loc_t char_assumed_shape_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
19 struct loc_t char_assumed_shape_in_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
20 struct loc_t char_assumed_shape_cont_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
21 struct loc_t char_assumed_shape_cont_in_f (CFI_cdesc_t *, CFI_cdesc_t *, CFI_cdesc_t *, int, int);
22
23 static void
24 basic_check(CFI_cdesc_t *x, bool is_cont)
25 {
26 if (!x->base_addr)
27 __builtin_abort ();
28 if (x->elem_len != 3*(4*sizeof(char))) /* ucs4_char */
29 __builtin_abort ();
30 if (x->version != CFI_VERSION)
31 __builtin_abort ();
32 if (x->rank != 1)
33 __builtin_abort ();
34 if (x->attribute != CFI_attribute_other)
35 __builtin_abort ();
36 if (x->type != CFI_type_ucs4_char)
37 __builtin_abort ();
38 if (x->dim[0].lower_bound != 0)
39 __builtin_abort ();
40 if (x->dim[0].extent != 3)
41 __builtin_abort ();
42 if (CFI_is_contiguous (x) != (x->elem_len == x->dim[0].sm))
43 __builtin_abort ();
44 if (is_cont != CFI_is_contiguous (x))
45 __builtin_abort ();
46 }
47
48 static void
49 print_str (void *p, size_t len)
50 {
51 __builtin_printf ("DEBUG: >");
52 /* Use ' ' for '\0' */
53 for (size_t i = 0; i < len*4; ++i)
54 __builtin_printf ("%c", ((const char*) p)[i] ? ((const char*) p)[i] : ' ');
55 __builtin_printf ("<\n");
56 }
57
58 static void
59 check_str (CFI_cdesc_t *x, const char *str, size_t n, const CFI_index_t subscripts[])
60 {
61 /* Avoid checking for '\0'. */
62 if (memcmp ((const char*) CFI_address (x, subscripts), str, n) != 0)
63 __builtin_abort ();
64 }
65
66 static void
67 set_str (CFI_cdesc_t *x, const char *str, size_t n, const CFI_index_t subscripts[])
68 {
69 char *p = CFI_address (x, subscripts);
70 if (x->elem_len != n)
71 __builtin_abort ();
72 for (size_t i = 0; i < n; ++i)
73 p[i] = str[i];
74 }
75
76 static struct loc_t
77 do_call (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
78 int k, int num, bool intent_in, ftn_fn fn, bool is_cont, bool fort_cont)
79 {
80 const CFI_index_t zero[1] = { 0 };
81 const CFI_index_t one[1] = { 1 };
82 const CFI_index_t two[1] = { 2 };
83 struct loc_t addr1, addr2;
84 if (k != 3)
85 __builtin_abort ();
86 basic_check (x, is_cont || num == 2);
87 basic_check (y, is_cont || num == 2);
88 basic_check (z, is_cont || num == 2);
89 if (!is_cont && num == 1)
90 {
91 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
92 check_str (x, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
93 check_str (x, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
94 check_str (x, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
95 check_str (y, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
96 check_str (y, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
97 check_str (y, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
98 check_str (z, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
99 check_str (z, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
100 check_str (z, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
101 #elif __BYTE_ORDER__ == __ORDER_BIG_ENDIAN__
102 check_str (x, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
103 check_str (x, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
104 check_str (x, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
105 check_str (y, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
106 check_str (y, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
107 check_str (y, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
108 check_str (z, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
109 check_str (z, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
110 check_str (z, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
111 #else
112 #error "Unsupported __BYTE_ORDER__"
113 #endif
114 }
115 else if (num == 1)
116 {
117 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
118 if (memcmp ((const char*) x->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
119 __builtin_abort ();
120 if (memcmp ((const char*) y->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
121 __builtin_abort ();
122 if (memcmp ((const char*) z->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
123 __builtin_abort ();
124 #else
125 if (memcmp ((const char*) x->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
126 __builtin_abort ();
127 if (memcmp ((const char*) y->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
128 __builtin_abort ();
129 if (memcmp ((const char*) z->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
130 __builtin_abort ();
131 #endif
132 }
133 else if (num == 2)
134 {
135 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
136 if (memcmp ((const char*) x->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9*4) != 0)
137 __builtin_abort ();
138 if (memcmp ((const char*) y->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9*4) != 0)
139 __builtin_abort ();
140 if (memcmp ((const char*) z->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9*4) != 0)
141 __builtin_abort ();
142 #else
143 if (memcmp ((const char*) x->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9*4) != 0)
144 __builtin_abort ();
145 if (memcmp ((const char*) y->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9*4) != 0)
146 __builtin_abort ();
147 if (memcmp ((const char*) z->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9*4) != 0)
148 __builtin_abort ();
149 #endif
150 }
151 else
152 __builtin_abort ();
153 addr1.x = (intptr_t) x->base_addr;
154 addr1.y = (intptr_t) y->base_addr;
155 addr1.z = (intptr_t) z->base_addr;
156 addr2 = fn (x, y, z, 3, num);
157 if (!CFI_is_contiguous (x) && fort_cont)
158 {
159 /* Check for callee copy in/copy out. */
160 if (addr1.x == addr2.x || addr1.x != (intptr_t) x->base_addr)
161 __builtin_abort ();
162 if (addr1.y == addr2.y || addr1.y != (intptr_t) y->base_addr)
163 __builtin_abort ();
164 if (addr1.z == addr2.z || addr1.z != (intptr_t) z->base_addr)
165 __builtin_abort ();
166 }
167 else
168 {
169 if (addr1.x != addr2.x || addr1.x != (intptr_t) x->base_addr)
170 __builtin_abort ();
171 if (addr1.y != addr2.y || addr1.y != (intptr_t) y->base_addr)
172 __builtin_abort ();
173 if (addr1.z != addr2.z || addr1.z != (intptr_t) z->base_addr)
174 __builtin_abort ();
175 }
176 // intent_in
177 if (intent_in && !is_cont && num == 1)
178 {
179 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
180 check_str (x, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
181 check_str (x, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
182 check_str (x, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
183 check_str (y, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
184 check_str (y, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
185 check_str (y, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
186 check_str (z, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
187 check_str (z, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
188 check_str (z, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
189 #else
190 check_str (x, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
191 check_str (x, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
192 check_str (x, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
193 check_str (y, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
194 check_str (y, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
195 check_str (y, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
196 check_str (z, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
197 check_str (z, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
198 check_str (z, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
199 #endif
200 }
201 else if (intent_in && num == 1)
202 {
203 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
204 if (memcmp ((const char*) x->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
205 __builtin_abort ();
206 if (memcmp ((const char*) y->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
207 __builtin_abort ();
208 if (memcmp ((const char*) z->base_addr, "a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p\0\0\0", 9*4) != 0)
209 __builtin_abort ();
210 #else
211 if (memcmp ((const char*) x->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
212 __builtin_abort ();
213 if (memcmp ((const char*) y->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
214 __builtin_abort ();
215 if (memcmp ((const char*) z->base_addr, "\0\0\0a\0\0\0b\0\0\0c\0\0\0g\0\0\0h\0\0\0i\0\0\0n\0\0\0o\0\0\0p", 9*4) != 0)
216 __builtin_abort ();
217 #endif
218 }
219 else if (intent_in && num == 2)
220 {
221 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
222 if (memcmp ((const char*) x->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9) != 0)
223 __builtin_abort ();
224 if (memcmp ((const char*) y->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9) != 0)
225 __builtin_abort ();
226 if (memcmp ((const char*) z->base_addr, "d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m\0\0\0", 9) != 0)
227 __builtin_abort ();
228 #else
229 if (memcmp ((const char*) x->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9) != 0)
230 __builtin_abort ();
231 if (memcmp ((const char*) y->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9) != 0)
232 __builtin_abort ();
233 if (memcmp ((const char*) z->base_addr, "\0\0\0d\0\0\0e\0\0\0f\0\0\0g\0\0\0h\0\0\0i\0\0\0j\0\0\0l\0\0\0m", 9) != 0)
234 __builtin_abort ();
235 #endif
236 }
237 else if (intent_in)
238 __builtin_abort ();
239 if (intent_in)
240 {
241 if (is_cont && num == 1)
242 {
243 /* Copy in - set the value to check that no copy out is done. */
244 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
245 memcpy ((char*) x->base_addr, "1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9\0\0\0", 9*4);
246 memcpy ((char*) y->base_addr, "1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9\0\0\0", 9*4);
247 memcpy ((char*) z->base_addr, "1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9\0\0\0", 9*4);
248 #else
249 memcpy ((char*) x->base_addr, "\0\0\0""1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9", 9*4);
250 memcpy ((char*) y->base_addr, "\0\0\0""1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9", 9*4);
251 memcpy ((char*) z->base_addr, "\0\0\0""1\0\0\0""2\0\0\0""3\0\0\0""4\0\0\0""5\0\0\0""6\0\0\0""7\0\0\0""8\0\0\0""9", 9*4);
252 #endif
253 }
254 return addr1;
255 }
256 // !intent_in
257 if (!is_cont && num == 1)
258 {
259 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
260 check_str (x, "A\0\0\0B\0\0\0C\0\0\0", 3*4, zero);
261 check_str (x, "D\0\0\0E\0\0\0F\0\0\0", 3*4, one);
262 check_str (x, "G\0\0\0H\0\0\0I\0\0\0", 3*4, two);
263 check_str (y, "A\0\0\0B\0\0\0C\0\0\0", 3*4, zero);
264 check_str (y, "D\0\0\0E\0\0\0F\0\0\0", 3*4, one);
265 check_str (y, "G\0\0\0H\0\0\0I\0\0\0", 3*4, two);
266 check_str (z, "A\0\0\0B\0\0\0C\0\0\0", 3*4, zero);
267 check_str (z, "D\0\0\0E\0\0\0F\0\0\0", 3*4, one);
268 check_str (z, "G\0\0\0H\0\0\0I\0\0\0", 3*4, two);
269 #else
270 check_str (x, "\0\0\0A\0\0\0B\0\0\0C", 3*4, zero);
271 check_str (x, "\0\0\0D\0\0\0E\0\0\0F", 3*4, one);
272 check_str (x, "\0\0\0G\0\0\0H\0\0\0I", 3*4, two);
273 check_str (y, "\0\0\0A\0\0\0B\0\0\0C", 3*4, zero);
274 check_str (y, "\0\0\0D\0\0\0E\0\0\0F", 3*4, one);
275 check_str (y, "\0\0\0G\0\0\0H\0\0\0I", 3*4, two);
276 check_str (z, "\0\0\0A\0\0\0B\0\0\0C", 3*4, zero);
277 check_str (z, "\0\0\0D\0\0\0E\0\0\0F", 3*4, one);
278 check_str (z, "\0\0\0G\0\0\0H\0\0\0I", 3*4, two);
279 #endif
280 }
281 else
282 {
283 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
284 if (memcmp ((const char*) x->base_addr, "A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I\0\0\0", 9*4) != 0)
285 __builtin_abort ();
286 if (memcmp ((const char*) y->base_addr, "A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I\0\0\0", 9*4) != 0)
287 __builtin_abort ();
288 if (memcmp ((const char*) z->base_addr, "A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I\0\0\0", 9*4) != 0)
289 __builtin_abort ();
290 #else
291 if (memcmp ((const char*) x->base_addr, "\0\0\0A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I", 9*4) != 0)
292 __builtin_abort ();
293 if (memcmp ((const char*) y->base_addr, "\0\0\0A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I", 9*4) != 0)
294 __builtin_abort ();
295 if (memcmp ((const char*) z->base_addr, "\0\0\0A\0\0\0B\0\0\0C\0\0\0D\0\0\0E\0\0\0F\0\0\0G\0\0\0H\0\0\0I", 9*4) != 0)
296 __builtin_abort ();
297 #endif
298 }
299 return addr1;
300 }
301
302 struct loc_t
303 char_assumed_size_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
304 int k, int num)
305 {
306 return do_call (x, y, z, k, num, false, char_assumed_size_f, true, false);
307 }
308
309 struct loc_t
310 char_assumed_size_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
311 int k, int num)
312 {
313 return do_call (x, y, z, k, num, true, char_assumed_size_in_f, true, false);
314 }
315
316 struct loc_t
317 char_expl_size_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
318 int k, int num)
319 {
320 return do_call (x, y, z, k, num, false, char_expl_size_f, true, false);
321 }
322
323 struct loc_t
324 char_expl_size_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
325 int k, int num)
326 {
327 return do_call (x, y, z, k, num, true, char_expl_size_in_f, true, false);
328 }
329
330 struct loc_t
331 char_assumed_rank_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
332 int k, int num)
333 {
334 return do_call (x, y, z, k, num, false, char_assumed_rank_f, false, false);
335 }
336
337 struct loc_t
338 char_assumed_rank_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
339 int k, int num)
340 {
341 return do_call (x, y, z, k, num, true, char_assumed_rank_in_f, false, false);
342 }
343
344 struct loc_t
345 char_assumed_rank_cont_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
346 int k, int num)
347 {
348 return do_call (x, y, z, k, num, false, char_assumed_rank_cont_f, true, false);
349 }
350
351 struct loc_t
352 char_assumed_rank_cont_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
353 int k, int num)
354 {
355 return do_call (x, y, z, k, num, true, char_assumed_rank_cont_in_f, true, false);
356 }
357
358 static void
359 reset_var (CFI_cdesc_t *x, int num)
360 {
361 const CFI_index_t zero[1] = { 0 };
362 const CFI_index_t one[1] = { 1 };
363 const CFI_index_t two[1] = { 2 };
364
365 if (num == 1)
366 {
367 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
368 set_str (x, "a\0\0\0b\0\0\0c\0\0\0", 3*4, zero);
369 set_str (x, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
370 set_str (x, "n\0\0\0o\0\0\0p\0\0\0", 3*4, two);
371 #else
372 set_str (x, "\0\0\0a\0\0\0b\0\0\0c", 3*4, zero);
373 set_str (x, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
374 set_str (x, "\0\0\0n\0\0\0o\0\0\0p", 3*4, two);
375 #endif
376 }
377 else if (num == 2)
378 {
379 #if __BYTE_ORDER__ == __ORDER_LITTLE_ENDIAN__
380 set_str (x, "d\0\0\0e\0\0\0f\0\0\0", 3*4, zero);
381 set_str (x, "g\0\0\0h\0\0\0i\0\0\0", 3*4, one);
382 set_str (x, "j\0\0\0l\0\0\0m\0\0\0", 3*4, two);
383 #else
384 set_str (x, "\0\0\0d\0\0\0e\0\0\0f", 3*4, zero);
385 set_str (x, "\0\0\0g\0\0\0h\0\0\0i", 3*4, one);
386 set_str (x, "\0\0\0j\0\0\0l\0\0\0m", 3*4, two);
387 #endif
388 }
389 else
390 __builtin_abort ();
391 }
392
393 static void
394 reset_vars (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z, int num)
395 {
396 reset_var (x, num);
397 reset_var (y, num);
398 reset_var (z, num);
399 }
400
401 struct loc_t
402 char_assumed_shape_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
403 int k, int num)
404 {
405 /* Make use of having a noncontiguous argument to check that the callee
406 handles noncontiguous variables. */
407 do_call (x, y, z, k, num, false, char_assumed_size_f, false, true);
408 reset_vars (x, y, z, num);
409 do_call (x, y, z, k, num, true, char_assumed_size_in_f, false, true);
410 reset_vars (x, y, z, num);
411 do_call (x, y, z, k, num, false, char_expl_size_f, false, true);
412 reset_vars (x, y, z, num);
413 do_call (x, y, z, k, num, true, char_expl_size_in_f, false, true);
414 reset_vars (x, y, z, num);
415 do_call (x, y, z, k, num, false, char_assumed_rank_cont_f, false, true);
416 reset_vars (x, y, z, num);
417 do_call (x, y, z, k, num, true, char_assumed_rank_cont_in_f, false, true);
418 reset_vars (x, y, z, num);
419 do_call (x, y, z, k, num, false, char_assumed_shape_cont_f, false, true);
420 reset_vars (x, y, z, num);
421 do_call (x, y, z, k, num, true, char_assumed_shape_cont_in_f, false, true);
422 /* Actual func call. */
423 reset_vars (x, y, z, num);
424 return do_call (x, y, z, k, num, false, char_assumed_shape_f, false, false);
425 }
426
427 struct loc_t
428 char_assumed_shape_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
429 int k, int num)
430 {
431 return do_call (x, y, z, k, num, true, char_assumed_shape_in_f, false, false);
432 }
433
434 struct loc_t
435 char_assumed_shape_cont_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
436 int k, int num)
437 {
438 return do_call (x, y, z, k, num, false, char_assumed_shape_cont_f, true, false);
439 }
440
441 struct loc_t
442 char_assumed_shape_cont_in_c (CFI_cdesc_t *x, CFI_cdesc_t *y, CFI_cdesc_t *z,
443 int k, int num)
444 {
445 return do_call (x, y, z, k, num, true, char_assumed_shape_cont_in_f, true, false);
446 }