1 #include <stdlib.h>
2 #include <stdint.h>
3 #include <stdio.h>
4 #include <string.h>
5
6 #include <ISO_Fortran_binding.h>
7 #include "dump-descriptors.h"
8
9 /* For simplicity, point descriptors at a static buffer. */
10 #define BUFSIZE 256
11 static char *buf[BUFSIZE] __attribute__ ((aligned (8)));
12 static CFI_index_t extents[] = {10};
13
14 /* External entry point. The arguments are descriptors for input arrays;
15 we'll construct new descriptors for the outputs of CFI_section. */
16 extern void ctest (void);
17
18 void
ctest(void)19 ctest (void)
20 {
21 int bad = 0;
22 int status;
23 CFI_CDESC_T(1) sdesc;
24 CFI_cdesc_t *source = (CFI_cdesc_t *) &sdesc;
25 CFI_CDESC_T(3) rdesc;
26 CFI_cdesc_t *result = (CFI_cdesc_t *) &rdesc;
27 CFI_index_t lb = 2;
28 CFI_index_t ub = 8;
29 CFI_index_t step = 2;
30 CFI_index_t zstep = 0;
31
32 /* Use a 1-d integer source array for the first few tests. */
33 check_CFI_status ("CFI_establish",
34 CFI_establish (source, (void *)buf, CFI_attribute_other,
35 CFI_type_int, 0, 1, extents));
36
37 /* result shall be the address of a C descriptor with rank equal
38 to the rank of source minus the number of zero strides. */
39 check_CFI_status ("CFI_establish",
40 CFI_establish (result, NULL, CFI_attribute_pointer,
41 CFI_type_int, 0, 0, NULL));
42 status = CFI_section (result, source, &lb, &ub, &step);
43 if (status == CFI_SUCCESS)
44 {
45 fprintf (stderr,
46 "no error for rank mismatch (too small)\n");
47 bad ++;
48 }
49
50 check_CFI_status ("CFI_establish",
51 CFI_establish (result, NULL, CFI_attribute_pointer,
52 CFI_type_int, 0, 1, NULL));
53 status = CFI_section (result, source, &lb, &lb, &zstep);
54 if (status == CFI_SUCCESS)
55 {
56 fprintf (stderr,
57 "no error for rank mismatch (zero stride)\n");
58 bad ++;
59 }
60
61 check_CFI_status ("CFI_establish",
62 CFI_establish (result, NULL, CFI_attribute_pointer,
63 CFI_type_int, 0, 3, NULL));
64 status = CFI_section (result, source, &lb, &ub, &step);
65 if (status == CFI_SUCCESS)
66 {
67 fprintf (stderr,
68 "no error for rank mismatch (too large)\n");
69 bad ++;
70 }
71
72 /* The attribute member [of result] shall have the value
73 CFI_attribute_other or CFI_attribute_pointer. */
74 check_CFI_status ("CFI_establish",
75 CFI_establish (result, NULL, CFI_attribute_allocatable,
76 CFI_type_int, 0, 1, NULL));
77 status = CFI_section (result, source, &lb, &ub, &step);
78 if (status == CFI_SUCCESS)
79 {
80 fprintf (stderr,
81 "no error for CFI_attribute_allocatable result\n");
82 bad ++;
83 }
84
85 /* source shall be the address of a C descriptor that describes a
86 nonallocatable nonpointer array, an allocated allocatable array,
87 or an associated array pointer. */
88 check_CFI_status ("CFI_establish",
89 CFI_establish (source, NULL, CFI_attribute_allocatable,
90 CFI_type_int, 0, 1, NULL));
91 check_CFI_status ("CFI_establish",
92 CFI_establish (result, NULL, CFI_attribute_pointer,
93 CFI_type_int, 0, 1, NULL));
94 status = CFI_section (result, source, &lb, &ub, &step);
95 if (status == CFI_SUCCESS)
96 {
97 fprintf (stderr,
98 "no error for unallocated allocatable source array\n");
99 bad ++;
100 }
101
102 check_CFI_status ("CFI_establish",
103 CFI_establish (source, NULL, CFI_attribute_pointer,
104 CFI_type_int, 0, 1, NULL));
105 check_CFI_status ("CFI_establish",
106 CFI_establish (result, NULL, CFI_attribute_pointer,
107 CFI_type_int, 0, 1, NULL));
108 status = CFI_section (result, source, &lb, &ub, &step);
109 if (status == CFI_SUCCESS)
110 {
111 fprintf (stderr,
112 "no error for unassociated pointer source array\n");
113 bad ++;
114 }
115
116 /* The corresponding values of the elem_len and type members shall
117 be the same in the C descriptors with the addresses source
118 and result. */
119 check_CFI_status ("CFI_establish",
120 CFI_establish (source, (void *)buf, CFI_attribute_other,
121 CFI_type_struct,
122 sizeof(int), 1, extents));
123 check_CFI_status ("CFI_establish",
124 CFI_establish (result, NULL, CFI_attribute_pointer,
125 CFI_type_struct,
126 2*sizeof (int), 1, NULL));
127 status = CFI_section (result, source, &lb, &ub, &step);
128 if (status == CFI_SUCCESS)
129 {
130 fprintf (stderr,
131 "no error for elem_len mismatch\n");
132 bad ++;
133 }
134
135 check_CFI_status ("CFI_establish",
136 CFI_establish (result, NULL, CFI_attribute_pointer,
137 CFI_type_int, 0, 1, NULL));
138 status = CFI_section (result, source, &lb, &ub, &step);
139 if (status == CFI_SUCCESS)
140 {
141 fprintf (stderr,
142 "no error for type mismatch\n");
143 bad ++;
144 }
145
146 if (bad)
147 abort ();
148 }
149
150