1 #include <stdlib.h>
2 #include <stdio.h>
3
4 #include <ISO_Fortran_binding.h>
5 #include "dump-descriptors.h"
6
7 extern void ctest1 (CFI_cdesc_t *a);
8 extern void ctest2 (CFI_cdesc_t *a);
9 extern void ftest1 (CFI_cdesc_t *a, int first, int last, int step);
10 extern void ftest2 (CFI_cdesc_t *a, int first, int last, int step);
11
12 #if 0
13 static void
14 dump_array (CFI_cdesc_t *a, const char *name, const char *note)
15 {
16 int i;
17
18 fprintf (stderr, "%s\n", note);
19 for (i = 0; i < a->dim[0].extent; i++)
20 {
21 int j = i + a->dim[0].lower_bound;
22 int elt;
23 CFI_index_t sub[1];
24 sub[0] = j;
25 elt = *((int *) CFI_address (a, sub));
26 fprintf (stderr, "%s[%d] = %d\n", name, j, elt);
27 }
28 fprintf (stderr, "\n");
29 }
30 #else
31 #define dump_array(a, name, note)
32 #endif
33
34 static void
ctest(CFI_cdesc_t * a,int lb,int ub,int s,void (* fn)(CFI_cdesc_t *,int,int,int))35 ctest (CFI_cdesc_t *a, int lb, int ub, int s,
36 void (*fn) (CFI_cdesc_t *, int, int, int))
37 {
38 CFI_CDESC_T(1) bdesc;
39 CFI_cdesc_t *b = (CFI_cdesc_t *) &bdesc;
40 CFI_index_t lb_array[1], ub_array[1], s_array[1];
41 int i;
42
43 /* Dump the descriptor contents to test that we can access the fields
44 correctly, etc. */
45 dump_CFI_cdesc_t (a);
46
47 /* Make sure we got a valid descriptor. */
48 if (!a->base_addr)
49 abort ();
50 if (a->elem_len != sizeof(int))
51 abort ();
52 if (a->rank != 1)
53 abort ();
54 if (a->type != CFI_type_int)
55 abort ();
56 if (a->attribute != CFI_attribute_other)
57 abort ();
58
59 /* Create an array section and pass it to fn. */
60 check_CFI_status ("CFI_establish",
61 CFI_establish (b, NULL, CFI_attribute_other,
62 CFI_type_int,
63 sizeof (int), 1, NULL));
64 lb_array[0] = lb - 1 + a->dim[0].lower_bound;
65 ub_array[0] = ub - 1 + a->dim[0].lower_bound;
66 s_array[0] = s;
67 check_CFI_status ("CFI_section",
68 CFI_section (b, a, lb_array, ub_array, s_array));
69 dump_CFI_cdesc_t (b);
70 dump_array (b, "b", "b after CFI_section");
71
72 /* Pass it to the Fortran function fn. */
73 if (CFI_is_contiguous (b))
74 abort ();
75 (*fn) (b, lb, ub, s);
76 dump_CFI_cdesc_t (b);
77 dump_array (b, "b", "b after calling Fortran fn");
78
79 /* fn is supposed to negate the elements of the array section it
80 receives. Check that the original array has been updated. */
81 dump_array (a, "a", "a after calling Fortran fn");
82 for (i = 0; i < a->dim[0].extent; i++)
83 {
84 int elt;
85 int j = i + a->dim[0].lower_bound;
86 CFI_index_t sub[1];
87 sub[0] = j;
88 elt = *((int *) CFI_address (a, sub));
89 if (i + 1 >= lb && i + 1 <= ub && (i + 1 - lb) % s == 0)
90 {
91 if (elt != - (i + 1))
92 abort ();
93 }
94 else if (elt != (i + 1))
95 abort ();
96 }
97 }
98
99
100 /* Entry points for the Fortran side. */
101
102 void
ctest1(CFI_cdesc_t * a)103 ctest1 (CFI_cdesc_t *a)
104 {
105 ctest (a, 5, 13, 2, ftest1);
106 }
107
108 void
ctest2(CFI_cdesc_t * a)109 ctest2 (CFI_cdesc_t *a)
110 {
111 ctest (a, 8, 20, 3, ftest2);
112 }
113
114