1 #include <stdlib.h>
2 #include <stdio.h>
3
4 #include <ISO_Fortran_binding.h>
5 #include "dump-descriptors.h"
6
7 extern void ctest (CFI_cdesc_t *a, int lb, int ub, int s, CFI_cdesc_t *r);
8
9 /* Take a section of array A. OFF is the start index of A on the Fortran
10 side and the bounds LB and UB for the section to take are relative to
11 that base index. Store the result in R, which is supposed to be a pointer
12 array with lower bound 1. */
13
14 void
ctest(CFI_cdesc_t * a,int lb,int ub,int s,CFI_cdesc_t * r)15 ctest (CFI_cdesc_t *a, int lb, int ub, int s, CFI_cdesc_t *r)
16 {
17 CFI_index_t lb_array[1], ub_array[1], s_array[1];
18 CFI_index_t i, o;
19
20 /* Dump the descriptor contents to test that we can access the fields
21 correctly, etc. */
22 fprintf (stderr, "\n%s: lb=%d ub=%d s=%d\n",
23 (a->attribute == CFI_attribute_other) ? "non-pointer" : "pointer",
24 lb, ub, s);
25 dump_CFI_cdesc_t (a);
26 dump_CFI_cdesc_t (r);
27
28 /* Make sure we got a valid input descriptor. */
29 if (!a->base_addr)
30 abort ();
31 if (a->elem_len != sizeof(int))
32 abort ();
33 if (a->rank != 1)
34 abort ();
35 if (a->type != CFI_type_int)
36 abort ();
37 if (a->attribute == CFI_attribute_other)
38 {
39 if (a->dim[0].lower_bound != 0)
40 abort ();
41 /* Adjust the 1-based bounds. */
42 lb = lb - 1;
43 ub = ub - 1;
44 }
45 /* For pointer arrays, the bounds use the same indexing as the lower
46 bound in the array descriptor. */
47
48 /* Make sure we got a valid output descriptor. */
49 if (r->base_addr)
50 abort ();
51 if (r->elem_len != sizeof(int))
52 abort ();
53 if (r->rank != 1)
54 abort ();
55 if (r->type != CFI_type_int)
56 abort ();
57 if (r->attribute != CFI_attribute_pointer)
58 abort ();
59
60 /* Create an array section. */
61 lb_array[0] = lb;
62 ub_array[0] = ub;
63 s_array[0] = s;
64
65 check_CFI_status ("CFI_section",
66 CFI_section (r, a, lb_array, ub_array, s_array));
67
68 /* Check that the output descriptor is correct. */
69 dump_CFI_cdesc_t (r);
70 if (!r->base_addr)
71 abort ();
72 if (r->elem_len != sizeof(int))
73 abort ();
74 if (r->rank != 1)
75 abort ();
76 if (r->type != CFI_type_int)
77 abort ();
78 if (r->attribute != CFI_attribute_pointer)
79 abort ();
80
81 /* Check the contents of the output array. */
82 #if 0
83 for (o = r->dim[0].lower_bound, i = lb;
84 (s > 0 ? i <= ub : i >= ub);
85 o++, i += s)
86 {
87 int *input = (int *) CFI_address (a, &i);
88 int *output = (int *) CFI_address (r, &o);
89 fprintf (stderr, "a(%d) = %d, r(%d) = %d\n",
90 (int)i, *input, (int)o, *output);
91 }
92 #endif
93 for (o = r->dim[0].lower_bound, i = lb;
94 (s > 0 ? i <= ub : i >= ub);
95 o++, i += s)
96 {
97 int *input = (int *) CFI_address (a, &i);
98 int *output = (int *) CFI_address (r, &o);
99 if (*input != *output)
100 abort ();
101 }
102
103 /* Force the output array to be 1-based. */
104 lb_array[0] = 1;
105 check_CFI_status ("CFI_setpointer", CFI_setpointer (r, r, lb_array));
106 /* Check that the output descriptor is correct. */
107 dump_CFI_cdesc_t (r);
108 if (!r->base_addr)
109 abort ();
110 if (r->elem_len != sizeof(int))
111 abort ();
112 if (r->rank != 1)
113 abort ();
114 if (r->type != CFI_type_int)
115 abort ();
116 if (r->attribute != CFI_attribute_pointer)
117 abort ();
118 if (r->dim[0].lower_bound != 1)
119 abort ();
120
121 /* Check the contents of the output array again. */
122 for (o = r->dim[0].lower_bound, i = lb;
123 (s > 0 ? i <= ub : i >= ub);
124 o++, i += s)
125 {
126 int *input = (int *) CFI_address (a, &i);
127 int *output = (int *) CFI_address (r, &o);
128 if (*input != *output)
129 abort ();
130 }
131
132 }
133
134
135
136