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