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 (int imax, int jmax);
8 extern void frob (CFI_cdesc_t *a, CFI_cdesc_t *aa, CFI_cdesc_t *p);
9
10 struct m {
11 int i;
12 int j;
13 };
14
15 void
16 ctest (int imax, int jmax)
17 {
18 CFI_CDESC_T(2) adesc;
19 CFI_CDESC_T(2) aadesc;
20 CFI_CDESC_T(2) bdesc;
21 CFI_cdesc_t *a = (CFI_cdesc_t *) &adesc;
22 CFI_cdesc_t *aa = (CFI_cdesc_t *) &aadesc;
23 CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
24 CFI_index_t i, j;
25 CFI_index_t s[2];
26 CFI_index_t lb[2], ub[2];
27 struct m* mp;
28
29 /* Create and sanity-check a. */
30 check_CFI_status ("CFI_establish",
31 CFI_establish (a, NULL, CFI_attribute_allocatable,
32 CFI_type_struct,
33 sizeof (struct m), 2, NULL));
34 dump_CFI_cdesc_t (a);
35 if (a->version != CFI_VERSION)
36 abort ();
37 if (a->rank != 2)
38 abort ();
39 if (a->attribute != CFI_attribute_allocatable)
40 abort ();
41 if (a->base_addr)
42 abort ();
43 if (a->elem_len != sizeof (struct m))
44 abort ();
45
46 check_CFI_status ("CFI_establish",
47 CFI_establish (aa, NULL, CFI_attribute_allocatable,
48 CFI_type_struct,
49 sizeof (struct m), 2, NULL));
50 dump_CFI_cdesc_t (aa);
51 if (aa->version != CFI_VERSION)
52 abort ();
53 if (aa->rank != 2)
54 abort ();
55 if (aa->attribute != CFI_attribute_allocatable)
56 abort ();
57 if (aa->base_addr)
58 abort ();
59 if (aa->elem_len != sizeof (struct m))
60 abort ();
61
62 /* aa is allocated/initialized so that we can confirm that it's
63 magically deallocated when passed as intent(out). */
64 lb[0] = 0;
65 lb[1] = 0;
66 ub[0] = jmax;
67 ub[1] = jmax;
68 check_CFI_status ("CFI_allocate",
69 CFI_allocate (aa, lb, ub, 0));
70 for (j = 1; j <= jmax; j++)
71 for (i = 1; i <= imax; i++)
72 {
73 s[0] = j;
74 s[1] = i;
75 mp = (struct m *)CFI_address (aa, s);
76 mp->i = 0;
77 mp->j = 0;
78 }
79
80 /* Likewise create and sanity-check b. */
81 check_CFI_status ("CFI_establish",
82 CFI_establish (b, NULL, CFI_attribute_pointer,
83 CFI_type_struct,
84 sizeof (struct m), 2, NULL));
85 dump_CFI_cdesc_t (b);
86 if (b->version != CFI_VERSION)
87 abort ();
88 if (b->rank != 2)
89 abort ();
90 if (b->attribute != CFI_attribute_pointer)
91 abort ();
92 if (b->base_addr)
93 abort ();
94 if (b->elem_len != sizeof (struct m))
95 abort ();
96
97 /* Call back into Fortran, which will allocate and initialize the
98 objects. */
99 frob (a, aa, b);
100
101 dump_CFI_cdesc_t (a);
102 if (!a->base_addr)
103 abort ();
104 if (a->elem_len != sizeof (struct m))
105 abort ();
106 if (a->dim[0].lower_bound != 1)
107 abort ();
108 if (a->dim[0].extent != imax)
109 abort ();
110 if (a->dim[1].lower_bound != 1)
111 abort ();
112 if (a->dim[1].extent != jmax)
113 abort ();
114 for (j = 1; j <= jmax; j++)
115 for (i = 1; i <= imax; i++)
116 {
117 s[0] = i;
118 s[1] = j;
119 mp = (struct m *)CFI_address (a, s);
120 if (mp->i != i)
121 abort ();
122 if (mp->j != j)
123 abort ();
124 }
125
126 dump_CFI_cdesc_t (aa);
127 if (!aa->base_addr)
128 abort ();
129 if (aa->elem_len != sizeof (struct m))
130 abort ();
131 if (aa->dim[0].lower_bound != 1)
132 abort ();
133 if (aa->dim[0].extent != imax)
134 abort ();
135 if (aa->dim[1].lower_bound != 1)
136 abort ();
137 if (aa->dim[1].extent != jmax)
138 abort ();
139 for (j = 1; j <= jmax; j++)
140 for (i = 1; i <= imax; i++)
141 {
142 s[0] = i;
143 s[1] = j;
144 mp = (struct m *)CFI_address (aa, s);
145 if (mp->i != i)
146 abort ();
147 if (mp->j != j)
148 abort ();
149 }
150
151 dump_CFI_cdesc_t (b);
152 if (!b->base_addr)
153 abort ();
154 if (b->elem_len != sizeof (struct m))
155 abort ();
156 if (b->dim[0].lower_bound != 1)
157 abort ();
158 if (b->dim[0].extent != jmax)
159 abort ();
160 if (b->dim[1].lower_bound != 1)
161 abort ();
162 if (b->dim[1].extent != imax)
163 abort ();
164 for (j = 1; j <= jmax; j++)
165 for (i = 1; i <= imax; i++)
166 {
167 s[0] = j;
168 s[1] = i;
169 mp = (struct m *)CFI_address (b, s);
170 if (mp->i != i)
171 abort ();
172 if (mp->j != j)
173 abort ();
174 }
175 }