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 i;
9 int j;
10 };
11
12 extern void ctest (CFI_cdesc_t *a, int lb1, int ub1, int s1,
13 int lb2, int ub2, int s2, CFI_cdesc_t *b);
14
15 /* Check array b against the section of array a defined by the given
16 bounds. */
17 static void
18 check_array (CFI_cdesc_t *a, CFI_cdesc_t *b,
19 int lb1, int ub1, int s1, int lb2, int ub2, int s2)
20 {
21 int bad = 0;
22 int i, ii, j, jj;
23 CFI_index_t sub[2];
24 struct m *ap, *bp;
25
26 for (j = lb2, jj = b->dim[1].lower_bound; j <= ub2; jj++, j += s2)
27 for (i = lb1, ii = b->dim[0].lower_bound; i <= ub1; ii++, i += s1)
28 {
29 sub[0] = i;
30 sub[1] = j;
31 ap = (struct m *) CFI_address (a, sub);
32 sub[0] = ii;
33 sub[1] = jj;
34 bp = (struct m *) CFI_address (b, sub);
35 #if 0
36 fprintf (stderr, "b(%d,%d) = (%d,%d) expecting (%d,%d)\n",
37 ii, jj, bp->i, bp->j, ap->i, ap->j);
38 #endif
39 if (ap->i != bp->i || ap->j != bp->j)
40 bad = 1;
41 }
42 if (bad)
43 abort ();
44 }
45
46 void
47 ctest (CFI_cdesc_t *a, int lb1, int ub1, int s1,
48 int lb2, int ub2, int s2, CFI_cdesc_t *b)
49 {
50 CFI_index_t lb[2], ub[2], s[2];
51 CFI_index_t i, j;
52
53 /* Dump the descriptor contents to test that we can access the fields
54 correctly, etc. */
55 fprintf (stderr, "input arrays\n");
56 dump_CFI_cdesc_t (a);
57 dump_CFI_cdesc_t (b);
58
59 /* We expect to get a zero-based input array of shape (10,5). */
60 if (a->rank != 2)
61 abort ();
62 if (a->attribute != CFI_attribute_other)
63 abort ();
64 if (a->type != CFI_type_struct)
65 abort ();
66 if (a->dim[0].lower_bound != 0)
67 abort ();
68 if (a->dim[0].extent != 10)
69 abort ();
70 if (a->dim[1].lower_bound != 0)
71 abort ();
72 if (a->dim[1].extent != 5)
73 abort ();
74
75 /* The output descriptor has to agree with the input descriptor. */
76 if (b->rank != 2)
77 abort ();
78 if (b->attribute != CFI_attribute_pointer)
79 abort ();
80 if (b->type != CFI_type_struct)
81 abort ();
82 if (b->elem_len != a->elem_len)
83 abort ();
84
85 /* Point b at a, keeping the 0-based bounds. */
86 check_CFI_status ("CFI_setpointer",
87 CFI_setpointer (b, a, NULL));
88 fprintf (stderr, "After initializing b\n");
89 dump_CFI_cdesc_t (b);
90 if (b->dim[0].lower_bound != 0)
91 abort ();
92 if (b->dim[1].lower_bound != 0)
93 abort ();
94 check_array (a, b,
95 a->dim[0].lower_bound,
96 a->dim[0].lower_bound + a->dim[0].extent - 1,
97 1,
98 a->dim[1].lower_bound,
99 a->dim[1].lower_bound + a->dim[1].extent - 1,
100 1);
101
102 /* Take a section of the array. The bounds passed in to this function
103 assume the array is 1-based in both dimensions, so subtract 1. */
104 lb[0] = b->dim[0].lower_bound + lb1 - 1;
105 lb[1] = b->dim[1].lower_bound + lb2 - 1;
106 ub[0] = b->dim[0].lower_bound + ub1 - 1;
107 ub[1] = b->dim[1].lower_bound + ub2 - 1;
108 s[0] = s1;
109 s[1] = s2;
110 check_CFI_status ("CFI_section",
111 CFI_section (b, b, lb, ub, s));
112 fprintf (stderr, "After CFI_section\n");
113 dump_CFI_cdesc_t (b);
114 check_array (a, b,
115 a->dim[0].lower_bound + lb1 - 1,
116 a->dim[0].lower_bound + ub1 - 1,
117 s1,
118 a->dim[1].lower_bound + lb2 - 1,
119 a->dim[1].lower_bound + ub2 - 1,
120 s2);
121
122 /* Adjust b to be 1-based. */
123 lb[0] = 1;
124 lb[1] = 1;
125 fprintf (stderr, "After rebasing b again\n");
126 check_CFI_status ("CFI_setpointer",
127 CFI_setpointer (b, b, lb));
128 dump_CFI_cdesc_t (b);
129 check_array (a, b,
130 a->dim[0].lower_bound + lb1 - 1,
131 a->dim[0].lower_bound + ub1 - 1,
132 s1,
133 a->dim[1].lower_bound + lb2 - 1,
134 a->dim[1].lower_bound + ub2 - 1,
135 s2);
136 }