1 /* This file contains some useful routines for debugging problems with C
2 descriptors. Compiling it also acts as a test that the implementation of
3 ISO_Fortran_binding.h provides all the types and constants specified in
4 TS29113. */
5
6 #include <stdio.h>
7 #include <stddef.h>
8 #include <stdlib.h>
9 #include "dump-descriptors.h"
10
11 void
12 dump_CFI_cdesc_t (CFI_cdesc_t *d)
13 {
14 fprintf (stderr, "<CFI_cdesc_t base_addr=%p elem_len=%ld version=%d",
15 d->base_addr, (long)(d->elem_len), d->version);
16 fprintf (stderr, "\n rank=");
17 dump_CFI_rank_t (d->rank);
18 fprintf (stderr, " type=");
19 dump_CFI_type_t (d->type);
20 fprintf (stderr, " attribute=");
21 dump_CFI_attribute_t (d->attribute);
22
23 /* Dimension info may not be initialized if it's an allocatable
24 or pointer descriptor with a null base_addr. */
25 if (d->rank > 0 && d->base_addr)
26 {
27 CFI_rank_t i;
28 for (i = 0; i < d->rank; i++)
29 {
30 if (i == 0)
31 fprintf (stderr, "\n dim=[");
32 else
33 fprintf (stderr, ",\n ");
34 dump_CFI_dim_t (d->dim + i);
35 }
36 fprintf (stderr, "]");
37 }
38 fprintf (stderr, ">\n");
39 }
40
41 void
42 dump_CFI_dim_t (CFI_dim_t *d)
43 {
44 fprintf (stderr, "<CFI_dim_t lower_bound=");
45 dump_CFI_index_t (d->lower_bound);
46 fprintf (stderr, " extent=");
47 dump_CFI_index_t (d->extent);
48 fprintf (stderr, " sm=");
49 dump_CFI_index_t (d->sm);
50 fprintf (stderr, ">");
51 }
52
53 void
54 dump_CFI_attribute_t (CFI_attribute_t a)
55 {
56 switch (a)
57 {
58 case CFI_attribute_pointer:
59 fprintf (stderr, "CFI_attribute_pointer");
60 break;
61 case CFI_attribute_allocatable:
62 fprintf (stderr, "CFI_attribute_allocatable");
63 break;
64 case CFI_attribute_other:
65 fprintf (stderr, "CFI_attribute_other");
66 break;
67 default:
68 fprintf (stderr, "unknown(%d)", (int)a);
69 break;
70 }
71 }
72
73 void
74 dump_CFI_index_t (CFI_index_t i)
75 {
76 fprintf (stderr, "%ld", (long)i);
77 }
78
79 void
80 dump_CFI_rank_t (CFI_rank_t r)
81 {
82 fprintf (stderr, "%d", (int)r);
83 }
84
85 /* We can't use a switch statement to dispatch CFI_type_t because
86 the type name macros may not be unique. Iterate over a table
87 instead. */
88
89 struct type_name_map {
90 CFI_type_t t;
91 const char *n;
92 };
93
94 struct type_name_map type_names[] =
95 {
96 { CFI_type_signed_char, "CFI_type_signed_char" },
97 { CFI_type_short, "CFI_type_short" },
98 { CFI_type_int, "CFI_type_int" },
99 { CFI_type_long, "CFI_type_long" },
100 { CFI_type_long_long, "CFI_type_long_long" },
101 { CFI_type_size_t, "CFI_type_size_t" },
102 { CFI_type_int8_t, "CFI_type_int8_t" },
103 { CFI_type_int16_t, "CFI_type_int16_t" },
104 { CFI_type_int32_t, "CFI_type_int32_t" },
105 { CFI_type_int64_t, "CFI_type_int64_t" },
106 { CFI_type_int_least8_t, "CFI_type_int_least8_t" },
107 { CFI_type_int_least16_t, "CFI_type_int_least16_t" },
108 { CFI_type_int_least32_t, "CFI_type_int_least32_t" },
109 { CFI_type_int_least64_t, "CFI_type_int_least64_t" },
110 { CFI_type_int_fast8_t, "CFI_type_int_fast8_t" },
111 { CFI_type_int_fast16_t, "CFI_type_int_fast16_t" },
112 { CFI_type_int_fast32_t, "CFI_type_int_fast32_t" },
113 { CFI_type_int_fast64_t, "CFI_type_int_fast64_t" },
114 { CFI_type_intmax_t, "CFI_type_intmax_t" },
115 { CFI_type_intptr_t, "CFI_type_intptr_t" },
116 { CFI_type_ptrdiff_t, "CFI_type_ptrdiff_t" },
117 { CFI_type_float, "CFI_type_float" },
118 { CFI_type_double, "CFI_type_double" },
119 { CFI_type_long_double, "CFI_type_long_double" },
120 { CFI_type_float_Complex, "CFI_type_float_Complex" },
121 { CFI_type_double_Complex, "CFI_type_double_Complex" },
122 { CFI_type_long_double_Complex, "CFI_type_long_double_Complex" },
123 { CFI_type_Bool, "CFI_type_Bool" },
124 { CFI_type_char, "CFI_type_char" },
125 { CFI_type_cptr, "CFI_type_cptr" },
126 { CFI_type_struct, "CFI_type_struct" },
127 { CFI_type_other, "CFI_type_other" },
128 /* Extension types */
129 { CFI_type_int128_t, "CFI_type_int128_t" },
130 { CFI_type_int_least128_t, "CFI_type_int_least128_t" },
131 { CFI_type_int_fast128_t, "CFI_type_int_fast128_t" },
132 { CFI_type_ucs4_char, "CFI_type_ucs4_char" },
133 { CFI_type_float128, "CFI_type_float128" },
134 { CFI_type_float128_Complex, "CFI_type_float128_Complex" },
135 { CFI_type_cfunptr, "CFI_type_cfunptr" }
136 };
137
138 void
139 dump_CFI_type_t (CFI_type_t t)
140 {
141 int i;
142 for (i = 0; i < sizeof (type_names) / sizeof (struct type_name_map); i++)
143 if (type_names[i].t == t)
144 {
145 fprintf (stderr, "%s", type_names[i].n);
146 return;
147 }
148 fprintf (stderr, "unknown(%d)", (int)t);
149 }
150
151 void
152 check_CFI_status (const char *fn, int code)
153 {
154 const char *msg;
155 switch (code)
156 {
157 case CFI_SUCCESS:
158 return;
159 case CFI_ERROR_BASE_ADDR_NULL:
160 msg = "CFI_ERROR_BASE_ADDR_NULL";
161 break;
162 case CFI_ERROR_BASE_ADDR_NOT_NULL:
163 msg = "CFI_ERROR_BASE_ADDR_NOT_NULL";
164 break;
165 case CFI_INVALID_ELEM_LEN:
166 msg = "CFI_INVALID_ELEM_LEN";
167 break;
168 case CFI_INVALID_RANK:
169 msg = "CFI_INVALID_RANK";
170 break;
171 case CFI_INVALID_TYPE:
172 msg = "CFI_INVALID_TYPE";
173 break;
174 case CFI_INVALID_ATTRIBUTE:
175 msg = "CFI_INVALID_ATTRIBUTE";
176 break;
177 case CFI_INVALID_EXTENT:
178 msg = "CFI_INVALID_EXTENT";
179 break;
180 case CFI_INVALID_DESCRIPTOR:
181 msg = "CFI_INVALID_DESCRIPTOR";
182 break;
183 case CFI_ERROR_MEM_ALLOCATION:
184 msg = "CFI_ERROR_MEM_ALLOCATION";
185 break;
186 case CFI_ERROR_OUT_OF_BOUNDS:
187 msg = "CFI_ERROR_OUT_OF_BOUNDS";
188 break;
189 default:
190 msg = "unknown error";
191 break;
192 }
193 fprintf (stderr, "%s returned %s\n", fn, msg);
194 abort ();
195 }