]> git.ipfire.org Git - thirdparty/binutils-gdb.git/blame - gdb/ada-typeprint.c
gdb/testsuite: Merge whatis.exp and ctf-whatis.exp
[thirdparty/binutils-gdb.git] / gdb / ada-typeprint.c
CommitLineData
14f9c5c9 1/* Support for printing Ada types for GDB, the GNU debugger.
42a4f53d 2 Copyright (C) 1986-2019 Free Software Foundation, Inc.
14f9c5c9 3
a9762ec7 4 This file is part of GDB.
14f9c5c9 5
a9762ec7
JB
6 This program is free software; you can redistribute it and/or modify
7 it under the terms of the GNU General Public License as published by
8 the Free Software Foundation; either version 3 of the License, or
9 (at your option) any later version.
14f9c5c9 10
a9762ec7
JB
11 This program is distributed in the hope that it will be useful,
12 but WITHOUT ANY WARRANTY; without even the implied warranty of
13 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
14 GNU General Public License for more details.
14f9c5c9 15
a9762ec7
JB
16 You should have received a copy of the GNU General Public License
17 along with this program. If not, see <http://www.gnu.org/licenses/>. */
14f9c5c9
AS
18
19#include "defs.h"
4de283e4 20#include "bfd.h" /* Binary File Description */
4de283e4 21#include "gdbtypes.h"
4de283e4 22#include "value.h"
4de283e4
TT
23#include "c-lang.h"
24#include "cli/cli-style.h"
d55e5aa6 25#include "typeprint.h"
4de283e4
TT
26#include "target-float.h"
27#include "ada-lang.h"
28#include <ctype.h>
14f9c5c9 29
83e3a93c
PH
30static int print_selected_record_field_types (struct type *, struct type *,
31 int, int,
79d43c61
TT
32 struct ui_file *, int, int,
33 const struct type_print_options *);
aba02109 34
d2e4a39e 35static int print_record_field_types (struct type *, struct type *,
79d43c61
TT
36 struct ui_file *, int, int,
37 const struct type_print_options *);
14f9c5c9
AS
38\f
39
d2e4a39e
AS
40
41static char *name_buffer;
14f9c5c9
AS
42static int name_buffer_len;
43
4c4b4cd2
PH
44/* The (decoded) Ada name of TYPE. This value persists until the
45 next call. */
14f9c5c9 46
d2e4a39e 47static char *
4c4b4cd2 48decoded_type_name (struct type *type)
14f9c5c9
AS
49{
50 if (ada_type_name (type) == NULL)
51 return NULL;
d2e4a39e 52 else
14f9c5c9 53 {
0d5cff50 54 const char *raw_name = ada_type_name (type);
d2e4a39e 55 char *s, *q;
14f9c5c9
AS
56
57 if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
58 {
59 name_buffer_len = 16 + 2 * strlen (raw_name);
224c3ddb 60 name_buffer = (char *) xrealloc (name_buffer, name_buffer_len);
14f9c5c9
AS
61 }
62 strcpy (name_buffer, raw_name);
63
d2e4a39e 64 s = (char *) strstr (name_buffer, "___");
14f9c5c9
AS
65 if (s != NULL)
66 *s = '\0';
67
68 s = name_buffer + strlen (name_buffer) - 1;
69 while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
70 s -= 1;
71
72 if (s == name_buffer)
73 return name_buffer;
74
d2e4a39e 75 if (!islower (s[1]))
14f9c5c9
AS
76 return NULL;
77
78 for (s = q = name_buffer; *s != '\0'; q += 1)
79 {
80 if (s[0] == '_' && s[1] == '_')
81 {
d2e4a39e
AS
82 *q = '.';
83 s += 2;
14f9c5c9
AS
84 }
85 else
86 {
d2e4a39e
AS
87 *q = *s;
88 s += 1;
14f9c5c9
AS
89 }
90 }
91 *q = '\0';
92 return name_buffer;
93 }
94}
95
fb151210
JB
96/* Return nonzero if TYPE is a subrange type, and its bounds
97 are identical to the bounds of its subtype. */
98
99static int
100type_is_full_subrange_of_target_type (struct type *type)
101{
102 struct type *subtype;
103
104 if (TYPE_CODE (type) != TYPE_CODE_RANGE)
105 return 0;
106
107 subtype = TYPE_TARGET_TYPE (type);
108 if (subtype == NULL)
109 return 0;
110
950c97d8
JB
111 if (is_dynamic_type (type))
112 return 0;
113
fb151210
JB
114 if (ada_discrete_type_low_bound (type)
115 != ada_discrete_type_low_bound (subtype))
116 return 0;
117
118 if (ada_discrete_type_high_bound (type)
119 != ada_discrete_type_high_bound (subtype))
120 return 0;
121
122 return 1;
123}
124
125/* Print TYPE on STREAM, preferably as a range if BOUNDS_PREFERED_P
126 is nonzero. */
14f9c5c9
AS
127
128static void
fb151210
JB
129print_range (struct type *type, struct ui_file *stream,
130 int bounds_prefered_p)
14f9c5c9 131{
fb151210
JB
132 if (!bounds_prefered_p)
133 {
134 /* Try stripping all TYPE_CODE_RANGE layers whose bounds
135 are identical to the bounds of their subtype. When
136 the bounds of both types match, it can allow us to
137 print a range using the name of its base type, which
138 is easier to read. For instance, we would print...
139
140 array (character) of ...
141
142 ... instead of...
143
144 array ('["00"]' .. '["ff"]') of ... */
145 while (type_is_full_subrange_of_target_type (type))
146 type = TYPE_TARGET_TYPE (type);
147 }
148
43bbcdc2 149 switch (TYPE_CODE (type))
14f9c5c9
AS
150 {
151 case TYPE_CODE_RANGE:
14f9c5c9 152 case TYPE_CODE_ENUM:
43bbcdc2 153 {
ded4fc8f 154 LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
492d29ea 155 int got_error = 0;
e62e21fd 156
a70b8144 157 try
950c97d8
JB
158 {
159 lo = ada_discrete_type_low_bound (type);
160 hi = ada_discrete_type_high_bound (type);
161 }
230d2906 162 catch (const gdb_exception_error &e)
950c97d8
JB
163 {
164 /* This can happen when the range is dynamic. Sometimes,
165 resolving dynamic property values requires us to have
166 access to an actual object, which is not available
167 when the user is using the "ptype" command on a type.
168 Print the range as an unbounded range. */
169 fprintf_filtered (stream, "<>");
492d29ea 170 got_error = 1;
950c97d8 171 }
492d29ea
PA
172
173 if (!got_error)
950c97d8 174 {
16b9eb7b 175 ada_print_scalar (type, lo, stream);
950c97d8 176 fprintf_filtered (stream, " .. ");
16b9eb7b 177 ada_print_scalar (type, hi, stream);
950c97d8 178 }
43bbcdc2 179 }
14f9c5c9
AS
180 break;
181 default:
14f9c5c9 182 fprintf_filtered (stream, "%.*s",
d2e4a39e
AS
183 ada_name_prefix_len (TYPE_NAME (type)),
184 TYPE_NAME (type));
43bbcdc2 185 break;
14f9c5c9
AS
186 }
187}
188
189/* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
4c4b4cd2 190 set *N past the bound and its delimiter, if any. */
14f9c5c9
AS
191
192static void
e6a959d6 193print_range_bound (struct type *type, const char *bounds, int *n,
d2e4a39e 194 struct ui_file *stream)
14f9c5c9
AS
195{
196 LONGEST B;
5b4ee69b 197
14f9c5c9
AS
198 if (ada_scan_number (bounds, *n, &B, n))
199 {
4c4b4cd2
PH
200 /* STABS decodes all range types which bounds are 0 .. -1 as
201 unsigned integers (ie. the type code is TYPE_CODE_INT, not
202 TYPE_CODE_RANGE). Unfortunately, ada_print_scalar() relies
203 on the unsigned flag to determine whether the bound should
204 be printed as a signed or an unsigned value. This causes
205 the upper bound of the 0 .. -1 range types to be printed as
206 a very large unsigned number instead of -1.
7c964f07
UW
207 To workaround this stabs deficiency, we replace the TYPE by NULL
208 to indicate default output when we detect that the bound is negative,
4c4b4cd2
PH
209 and the type is a TYPE_CODE_INT. The bound is negative when
210 'm' is the last character of the number scanned in BOUNDS. */
211 if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
7c964f07 212 type = NULL;
14f9c5c9
AS
213 ada_print_scalar (type, B, stream);
214 if (bounds[*n] == '_')
215 *n += 2;
216 }
217 else
218 {
219 int bound_len;
e6a959d6
PA
220 const char *bound = bounds + *n;
221 const char *pend;
14f9c5c9
AS
222
223 pend = strstr (bound, "__");
224 if (pend == NULL)
225 *n += bound_len = strlen (bound);
d2e4a39e 226 else
14f9c5c9
AS
227 {
228 bound_len = pend - bound;
229 *n += bound_len + 2;
230 }
231 fprintf_filtered (stream, "%.*s", bound_len, bound);
232 }
233}
234
235/* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
236 the value (if found) of the bound indicated by SUFFIX ("___L" or
4c4b4cd2 237 "___U") according to the ___XD conventions. */
14f9c5c9
AS
238
239static void
d2e4a39e
AS
240print_dynamic_range_bound (struct type *type, const char *name, int name_len,
241 const char *suffix, struct ui_file *stream)
14f9c5c9 242{
14f9c5c9 243 LONGEST B;
3ec5942f
SM
244 std::string name_buf (name, name_len);
245 name_buf += suffix;
14f9c5c9 246
3ec5942f 247 if (get_int_var_value (name_buf.c_str (), B))
14f9c5c9
AS
248 ada_print_scalar (type, B, stream);
249 else
250 fprintf_filtered (stream, "?");
251}
252
28c85d6c 253/* Print RAW_TYPE as a range type, using any bound information
fb151210
JB
254 following the GNAT encoding (if available).
255
256 If BOUNDS_PREFERED_P is nonzero, force the printing of the range
257 using its bounds. Otherwise, try printing the range without
258 printing the value of the bounds, if possible (this is only
259 considered a hint, not a guaranty). */
14f9c5c9
AS
260
261static void
fb151210
JB
262print_range_type (struct type *raw_type, struct ui_file *stream,
263 int bounds_prefered_p)
14f9c5c9 264{
0d5cff50 265 const char *name;
14f9c5c9 266 struct type *base_type;
0d5cff50 267 const char *subtype_info;
14f9c5c9 268
28c85d6c
JB
269 gdb_assert (raw_type != NULL);
270 name = TYPE_NAME (raw_type);
271 gdb_assert (name != NULL);
1ce677a4
UW
272
273 if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
14f9c5c9
AS
274 base_type = TYPE_TARGET_TYPE (raw_type);
275 else
276 base_type = raw_type;
277
278 subtype_info = strstr (name, "___XD");
1ce677a4 279 if (subtype_info == NULL)
fb151210 280 print_range (raw_type, stream, bounds_prefered_p);
14f9c5c9
AS
281 else
282 {
283 int prefix_len = subtype_info - name;
e6a959d6 284 const char *bounds_str;
14f9c5c9
AS
285 int n;
286
287 subtype_info += 5;
288 bounds_str = strchr (subtype_info, '_');
289 n = 1;
290
d2e4a39e 291 if (*subtype_info == 'L')
14f9c5c9 292 {
4c4b4cd2 293 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9
AS
294 subtype_info += 1;
295 }
296 else
4c4b4cd2 297 print_dynamic_range_bound (base_type, name, prefix_len, "___L",
d2e4a39e 298 stream);
14f9c5c9
AS
299
300 fprintf_filtered (stream, " .. ");
301
d2e4a39e 302 if (*subtype_info == 'U')
4c4b4cd2 303 print_range_bound (base_type, bounds_str, &n, stream);
14f9c5c9 304 else
4c4b4cd2 305 print_dynamic_range_bound (base_type, name, prefix_len, "___U",
d2e4a39e 306 stream);
14f9c5c9 307 }
d2e4a39e 308}
14f9c5c9 309
4c4b4cd2 310/* Print enumerated type TYPE on STREAM. */
14f9c5c9
AS
311
312static void
ebf56fd3 313print_enum_type (struct type *type, struct ui_file *stream)
14f9c5c9
AS
314{
315 int len = TYPE_NFIELDS (type);
14e75d8e
JK
316 int i;
317 LONGEST lastval;
14f9c5c9
AS
318
319 fprintf_filtered (stream, "(");
320 wrap_here (" ");
321
322 lastval = 0;
323 for (i = 0; i < len; i++)
324 {
325 QUIT;
d2e4a39e
AS
326 if (i)
327 fprintf_filtered (stream, ", ");
14f9c5c9
AS
328 wrap_here (" ");
329 fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
14e75d8e 330 if (lastval != TYPE_FIELD_ENUMVAL (type, i))
14f9c5c9 331 {
14e75d8e
JK
332 fprintf_filtered (stream, " => %s",
333 plongest (TYPE_FIELD_ENUMVAL (type, i)));
334 lastval = TYPE_FIELD_ENUMVAL (type, i);
14f9c5c9
AS
335 }
336 lastval += 1;
337 }
338 fprintf_filtered (stream, ")");
339}
340
4c4b4cd2 341/* Print representation of Ada fixed-point type TYPE on STREAM. */
14f9c5c9
AS
342
343static void
ebf56fd3 344print_fixed_point_type (struct type *type, struct ui_file *stream)
14f9c5c9 345{
50eff16b
UW
346 struct value *delta = ada_delta (type);
347 struct value *small = ada_scaling_factor (type);
14f9c5c9 348
50eff16b 349 if (delta == nullptr)
14f9c5c9
AS
350 fprintf_filtered (stream, "delta ??");
351 else
352 {
50eff16b
UW
353 std::string str;
354 str = target_float_to_string (value_contents (delta),
355 value_type (delta), "%g");
356 fprintf_filtered (stream, "delta %s", str.c_str());
357 if (!value_equal (delta, small))
358 {
359 str = target_float_to_string (value_contents (small),
360 value_type (small), "%g");
361 fprintf_filtered (stream, " <'small = %s>", str.c_str());
362 }
14f9c5c9
AS
363 }
364}
365
4c4b4cd2
PH
366/* Print simple (constrained) array type TYPE on STREAM. LEVEL is the
367 recursion (indentation) level, in case the element type itself has
14f9c5c9 368 nested structure, and SHOW is the number of levels of internal
4c4b4cd2 369 structure to show (see ada_print_type). */
14f9c5c9
AS
370
371static void
d2e4a39e 372print_array_type (struct type *type, struct ui_file *stream, int show,
79d43c61 373 int level, const struct type_print_options *flags)
14f9c5c9
AS
374{
375 int bitsize;
376 int n_indices;
bfca584f 377 struct type *elt_type = NULL;
14f9c5c9 378
ad82864c 379 if (ada_is_constrained_packed_array_type (type))
727e3d2e
JB
380 type = ada_coerce_to_simple_array_type (type);
381
14f9c5c9
AS
382 bitsize = 0;
383 fprintf_filtered (stream, "array (");
384
cb249c71
TT
385 if (type == NULL)
386 {
7f6aba03
TT
387 fprintf_styled (stream, metadata_style.style (),
388 _("<undecipherable array type>"));
cb249c71
TT
389 return;
390 }
391
14f9c5c9 392 n_indices = -1;
54ae186f 393 if (ada_is_simple_array_type (type))
14f9c5c9 394 {
54ae186f
JB
395 struct type *range_desc_type;
396 struct type *arr_type;
14f9c5c9 397
54ae186f
JB
398 range_desc_type = ada_find_parallel_type (type, "___XA");
399 ada_fixup_array_indexes_type (range_desc_type);
28c85d6c 400
54ae186f
JB
401 bitsize = 0;
402 if (range_desc_type == NULL)
403 {
404 for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
405 arr_type = TYPE_TARGET_TYPE (arr_type))
14f9c5c9 406 {
54ae186f
JB
407 if (arr_type != type)
408 fprintf_filtered (stream, ", ");
fb151210
JB
409 print_range (TYPE_INDEX_TYPE (arr_type), stream,
410 0 /* bounds_prefered_p */);
54ae186f
JB
411 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
412 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
14f9c5c9
AS
413 }
414 }
d2e4a39e 415 else
14f9c5c9 416 {
54ae186f 417 int k;
5b4ee69b 418
54ae186f
JB
419 n_indices = TYPE_NFIELDS (range_desc_type);
420 for (k = 0, arr_type = type;
421 k < n_indices;
422 k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
423 {
424 if (k > 0)
425 fprintf_filtered (stream, ", ");
426 print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
fb151210 427 stream, 0 /* bounds_prefered_p */);
54ae186f
JB
428 if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
429 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
430 }
14f9c5c9
AS
431 }
432 }
54ae186f
JB
433 else
434 {
435 int i, i0;
436
437 for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
438 fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
439 }
14f9c5c9 440
bfca584f 441 elt_type = ada_array_element_type (type, n_indices);
14f9c5c9
AS
442 fprintf_filtered (stream, ") of ");
443 wrap_here ("");
bfca584f
PMR
444 ada_print_type (elt_type, "", stream, show == 0 ? 0 : show - 1, level + 1,
445 flags);
446 /* Arrays with variable-length elements are never bit-packed in practice but
447 compilers have to describe their stride so that we can properly fetch
448 individual elements. Do not say the array is packed in this case. */
449 if (bitsize > 0 && !is_dynamic_type (elt_type))
14f9c5c9
AS
450 fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
451}
452
453/* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
83e3a93c 454 STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
feb864b7 455 values. Return non-zero if the field is an encoding of
83e3a93c
PH
456 discriminant values, as in a standard variant record, and 0 if the
457 field is not so encoded (as happens with single-component variants
feb864b7 458 in types annotated with pragma Unchecked_Variant). */
14f9c5c9 459
83e3a93c 460static int
d2e4a39e
AS
461print_choices (struct type *type, int field_num, struct ui_file *stream,
462 struct type *val_type)
14f9c5c9
AS
463{
464 int have_output;
465 int p;
d2e4a39e 466 const char *name = TYPE_FIELD_NAME (type, field_num);
14f9c5c9
AS
467
468 have_output = 0;
469
4c4b4cd2 470 /* Skip over leading 'V': NOTE soon to be obsolete. */
14f9c5c9
AS
471 if (name[0] == 'V')
472 {
d2e4a39e 473 if (!ada_scan_number (name, 1, NULL, &p))
14f9c5c9
AS
474 goto Huh;
475 }
476 else
477 p = 0;
478
479 while (1)
480 {
d2e4a39e 481 switch (name[p])
14f9c5c9
AS
482 {
483 default:
83e3a93c
PH
484 goto Huh;
485 case '_':
486 case '\0':
487 fprintf_filtered (stream, " =>");
488 return 1;
14f9c5c9
AS
489 case 'S':
490 case 'R':
491 case 'O':
d2e4a39e 492 if (have_output)
14f9c5c9
AS
493 fprintf_filtered (stream, " | ");
494 have_output = 1;
495 break;
496 }
497
d2e4a39e 498 switch (name[p])
14f9c5c9
AS
499 {
500 case 'S':
501 {
502 LONGEST W;
5b4ee69b 503
d2e4a39e 504 if (!ada_scan_number (name, p + 1, &W, &p))
14f9c5c9
AS
505 goto Huh;
506 ada_print_scalar (val_type, W, stream);
507 break;
508 }
509 case 'R':
510 {
511 LONGEST L, U;
5b4ee69b 512
d2e4a39e
AS
513 if (!ada_scan_number (name, p + 1, &L, &p)
514 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
14f9c5c9
AS
515 goto Huh;
516 ada_print_scalar (val_type, L, stream);
517 fprintf_filtered (stream, " .. ");
518 ada_print_scalar (val_type, U, stream);
519 break;
520 }
521 case 'O':
522 fprintf_filtered (stream, "others");
523 p += 1;
524 break;
525 }
526 }
527
528Huh:
83e3a93c
PH
529 fprintf_filtered (stream, "?? =>");
530 return 0;
14f9c5c9
AS
531}
532
83e3a93c
PH
533/* Assuming that field FIELD_NUM of TYPE represents variants whose
534 discriminant is contained in OUTER_TYPE, print its components on STREAM.
535 LEVEL is the recursion (indentation) level, in case any of the fields
536 themselves have nested structure, and SHOW is the number of levels of
537 internal structure to show (see ada_print_type). For this purpose,
538 fields nested in a variant part are taken to be at the same level as
539 the fields immediately outside the variant part. */
14f9c5c9
AS
540
541static void
ebf56fd3
AS
542print_variant_clauses (struct type *type, int field_num,
543 struct type *outer_type, struct ui_file *stream,
79d43c61
TT
544 int show, int level,
545 const struct type_print_options *flags)
14f9c5c9
AS
546{
547 int i;
4c4b4cd2 548 struct type *var_type, *par_type;
14f9c5c9
AS
549 struct type *discr_type;
550
551 var_type = TYPE_FIELD_TYPE (type, field_num);
552 discr_type = ada_variant_discrim_type (var_type, outer_type);
553
554 if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
555 {
556 var_type = TYPE_TARGET_TYPE (var_type);
4c4b4cd2
PH
557 if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
558 return;
14f9c5c9
AS
559 }
560
4c4b4cd2
PH
561 par_type = ada_find_parallel_type (var_type, "___XVU");
562 if (par_type != NULL)
563 var_type = par_type;
564
d2e4a39e 565 for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
14f9c5c9
AS
566 {
567 fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
83e3a93c
PH
568 if (print_choices (var_type, i, stream, discr_type))
569 {
570 if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
79d43c61
TT
571 outer_type, stream, show, level + 4,
572 flags)
83e3a93c
PH
573 <= 0)
574 fprintf_filtered (stream, " null;");
575 }
576 else
577 print_selected_record_field_types (var_type, outer_type, i, i,
79d43c61 578 stream, show, level + 4, flags);
14f9c5c9
AS
579 }
580}
581
4c4b4cd2 582/* Assuming that field FIELD_NUM of TYPE is a variant part whose
14f9c5c9 583 discriminants are contained in OUTER_TYPE, print a description of it
4c4b4cd2
PH
584 on STREAM. LEVEL is the recursion (indentation) level, in case any of
585 the fields themselves have nested structure, and SHOW is the number of
586 levels of internal structure to show (see ada_print_type). For this
587 purpose, fields nested in a variant part are taken to be at the same
588 level as the fields immediately outside the variant part. */
14f9c5c9
AS
589
590static void
ebf56fd3 591print_variant_part (struct type *type, int field_num, struct type *outer_type,
79d43c61
TT
592 struct ui_file *stream, int show, int level,
593 const struct type_print_options *flags)
14f9c5c9
AS
594{
595 fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
d2e4a39e
AS
596 ada_variant_discrim_name
597 (TYPE_FIELD_TYPE (type, field_num)));
598 print_variant_clauses (type, field_num, outer_type, stream, show,
79d43c61 599 level + 4, flags);
14f9c5c9
AS
600 fprintf_filtered (stream, "\n%*send case;", level + 4, "");
601}
602
83e3a93c
PH
603/* Print a description on STREAM of the fields FLD0 through FLD1 in
604 record or union type TYPE, whose discriminants are in OUTER_TYPE.
605 LEVEL is the recursion (indentation) level, in case any of the
606 fields themselves have nested structure, and SHOW is the number of
607 levels of internal structure to show (see ada_print_type). Does
feb864b7 608 not print parent type information of TYPE. Returns 0 if no fields
83e3a93c
PH
609 printed, -1 for an incomplete type, else > 0. Prints each field
610 beginning on a new line, but does not put a new line at end. */
14f9c5c9
AS
611
612static int
83e3a93c
PH
613print_selected_record_field_types (struct type *type, struct type *outer_type,
614 int fld0, int fld1,
79d43c61
TT
615 struct ui_file *stream, int show, int level,
616 const struct type_print_options *flags)
14f9c5c9 617{
83e3a93c 618 int i, flds;
14f9c5c9
AS
619
620 flds = 0;
14f9c5c9 621
83e3a93c 622 if (fld0 > fld1 && TYPE_STUB (type))
14f9c5c9
AS
623 return -1;
624
83e3a93c 625 for (i = fld0; i <= fld1; i += 1)
14f9c5c9
AS
626 {
627 QUIT;
628
d2e4a39e 629 if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
14f9c5c9
AS
630 ;
631 else if (ada_is_wrapper_field (type, i))
632 flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
79d43c61 633 stream, show, level, flags);
d2e4a39e 634 else if (ada_is_variant_part (type, i))
14f9c5c9 635 {
79d43c61 636 print_variant_part (type, i, outer_type, stream, show, level, flags);
14f9c5c9
AS
637 flds = 1;
638 }
639 else
640 {
641 flds += 1;
642 fprintf_filtered (stream, "\n%*s", level + 4, "");
643 ada_print_type (TYPE_FIELD_TYPE (type, i),
644 TYPE_FIELD_NAME (type, i),
79d43c61 645 stream, show - 1, level + 4, flags);
14f9c5c9
AS
646 fprintf_filtered (stream, ";");
647 }
648 }
649
650 return flds;
651}
652
83e3a93c
PH
653/* Print a description on STREAM of all fields of record or union type
654 TYPE, as for print_selected_record_field_types, above. */
655
656static int
657print_record_field_types (struct type *type, struct type *outer_type,
79d43c61
TT
658 struct ui_file *stream, int show, int level,
659 const struct type_print_options *flags)
83e3a93c
PH
660{
661 return print_selected_record_field_types (type, outer_type,
662 0, TYPE_NFIELDS (type) - 1,
79d43c61 663 stream, show, level, flags);
83e3a93c
PH
664}
665
666
4c4b4cd2
PH
667/* Print record type TYPE on STREAM. LEVEL is the recursion (indentation)
668 level, in case the element type itself has nested structure, and SHOW is
669 the number of levels of internal structure to show (see ada_print_type). */
14f9c5c9
AS
670
671static void
d2e4a39e 672print_record_type (struct type *type0, struct ui_file *stream, int show,
79d43c61 673 int level, const struct type_print_options *flags)
14f9c5c9 674{
d2e4a39e
AS
675 struct type *parent_type;
676 struct type *type;
677
4c4b4cd2
PH
678 type = ada_find_parallel_type (type0, "___XVE");
679 if (type == NULL)
680 type = type0;
14f9c5c9
AS
681
682 parent_type = ada_parent_type (type);
d2e4a39e 683 if (ada_type_name (parent_type) != NULL)
25552254
JB
684 {
685 const char *parent_name = decoded_type_name (parent_type);
686
687 /* If we fail to decode the parent type name, then use the parent
688 type name as is. Not pretty, but should never happen except
689 when the debugging info is incomplete or incorrect. This
690 prevents a crash trying to print a NULL pointer. */
691 if (parent_name == NULL)
692 parent_name = ada_type_name (parent_type);
693 fprintf_filtered (stream, "new %s with record", parent_name);
694 }
4c4b4cd2 695 else if (parent_type == NULL && ada_is_tagged_type (type, 0))
0b48a291
PH
696 fprintf_filtered (stream, "tagged record");
697 else
698 fprintf_filtered (stream, "record");
14f9c5c9
AS
699
700 if (show < 0)
0b48a291 701 fprintf_filtered (stream, " ... end record");
14f9c5c9
AS
702 else
703 {
704 int flds;
705
706 flds = 0;
707 if (parent_type != NULL && ada_type_name (parent_type) == NULL)
d2e4a39e 708 flds += print_record_field_types (parent_type, parent_type,
79d43c61
TT
709 stream, show, level, flags);
710 flds += print_record_field_types (type, type, stream, show, level,
711 flags);
d2e4a39e 712
14f9c5c9 713 if (flds > 0)
0b48a291 714 fprintf_filtered (stream, "\n%*send record", level, "");
d2e4a39e 715 else if (flds < 0)
323e0a4a 716 fprintf_filtered (stream, _(" <incomplete type> end record"));
d2e4a39e 717 else
0b48a291 718 fprintf_filtered (stream, " null; end record");
14f9c5c9
AS
719 }
720}
721
722/* Print the unchecked union type TYPE in something resembling Ada
4c4b4cd2 723 format on STREAM. LEVEL is the recursion (indentation) level
14f9c5c9 724 in case the element type itself has nested structure, and SHOW is the
4c4b4cd2 725 number of levels of internal structure to show (see ada_print_type). */
14f9c5c9 726static void
d2e4a39e 727print_unchecked_union_type (struct type *type, struct ui_file *stream,
79d43c61
TT
728 int show, int level,
729 const struct type_print_options *flags)
14f9c5c9 730{
14f9c5c9 731 if (show < 0)
0b48a291 732 fprintf_filtered (stream, "record (?) is ... end record");
d2e4a39e 733 else if (TYPE_NFIELDS (type) == 0)
0b48a291 734 fprintf_filtered (stream, "record (?) is null; end record");
14f9c5c9
AS
735 else
736 {
737 int i;
738
0b48a291 739 fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
14f9c5c9 740
d2e4a39e 741 for (i = 0; i < TYPE_NFIELDS (type); i += 1)
14f9c5c9 742 {
0b48a291 743 fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
d2e4a39e 744 level + 12, "");
14f9c5c9
AS
745 ada_print_type (TYPE_FIELD_TYPE (type, i),
746 TYPE_FIELD_NAME (type, i),
79d43c61 747 stream, show - 1, level + 12, flags);
14f9c5c9
AS
748 fprintf_filtered (stream, ";");
749 }
750
0b48a291 751 fprintf_filtered (stream, "\n%*send case;\n%*send record",
d2e4a39e 752 level + 4, "", level, "");
14f9c5c9
AS
753 }
754}
d2e4a39e 755
14f9c5c9
AS
756
757
758/* Print function or procedure type TYPE on STREAM. Make it a header
4c4b4cd2 759 for function or procedure NAME if NAME is not null. */
14f9c5c9
AS
760
761static void
79d43c61
TT
762print_func_type (struct type *type, struct ui_file *stream, const char *name,
763 const struct type_print_options *flags)
14f9c5c9
AS
764{
765 int i, len = TYPE_NFIELDS (type);
766
7022349d
PA
767 if (TYPE_TARGET_TYPE (type) != NULL
768 && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
14f9c5c9
AS
769 fprintf_filtered (stream, "procedure");
770 else
771 fprintf_filtered (stream, "function");
772
d2e4a39e 773 if (name != NULL && name[0] != '\0')
ac8c53cc
PW
774 {
775 fputs_filtered (" ", stream);
776 fputs_styled (name, function_name_style.style (), stream);
777 }
14f9c5c9 778
d2e4a39e 779 if (len > 0)
14f9c5c9
AS
780 {
781 fprintf_filtered (stream, " (");
782 for (i = 0; i < len; i += 1)
783 {
784 if (i > 0)
785 {
786 fputs_filtered ("; ", stream);
787 wrap_here (" ");
788 }
d2e4a39e 789 fprintf_filtered (stream, "a%d: ", i + 1);
79d43c61
TT
790 ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
791 flags);
14f9c5c9
AS
792 }
793 fprintf_filtered (stream, ")");
d2e4a39e 794 }
14f9c5c9 795
7022349d
PA
796 if (TYPE_TARGET_TYPE (type) == NULL)
797 fprintf_filtered (stream, " return <unknown return type>");
798 else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
14f9c5c9
AS
799 {
800 fprintf_filtered (stream, " return ");
79d43c61 801 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
14f9c5c9
AS
802 }
803}
804
805
806/* Print a description of a type TYPE0.
807 Output goes to STREAM (via stdio).
808 If VARSTRING is a non-empty string, print as an Ada variable/field
809 declaration.
4c4b4cd2 810 SHOW+1 is the maximum number of levels of internal type structure
14f9c5c9
AS
811 to show (this applies to record types, enumerated types, and
812 array types).
813 SHOW is the number of levels of internal type structure to show
4c4b4cd2 814 when there is a type name for the SHOWth deepest level (0th is
14f9c5c9
AS
815 outer level).
816 When SHOW<0, no inner structure is shown.
4c4b4cd2 817 LEVEL indicates level of recursion (for nested definitions). */
14f9c5c9
AS
818
819void
25b524e8 820ada_print_type (struct type *type0, const char *varstring,
79d43c61
TT
821 struct ui_file *stream, int show, int level,
822 const struct type_print_options *flags)
14f9c5c9 823{
61ee279c 824 struct type *type = ada_check_typedef (ada_get_base_type (type0));
f192137b 825 char *type_name = decoded_type_name (type0);
14f9c5c9
AS
826 int is_var_decl = (varstring != NULL && varstring[0] != '\0');
827
828 if (type == NULL)
829 {
830 if (is_var_decl)
831 fprintf_filtered (stream, "%.*s: ",
d2e4a39e 832 ada_name_prefix_len (varstring), varstring);
7f6aba03 833 fprintf_styled (stream, metadata_style.style (), "<null type?>");
14f9c5c9
AS
834 return;
835 }
836
837 if (show > 0)
61ee279c 838 type = ada_check_typedef (type);
14f9c5c9
AS
839
840 if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
d2e4a39e
AS
841 fprintf_filtered (stream, "%.*s: ",
842 ada_name_prefix_len (varstring), varstring);
14f9c5c9 843
d2d43431 844 if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
14f9c5c9 845 {
d2e4a39e 846 fprintf_filtered (stream, "%.*s",
14f9c5c9
AS
847 ada_name_prefix_len (type_name), type_name);
848 return;
849 }
850
851 if (ada_is_aligner_type (type))
79d43c61 852 ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
d2d43431
JB
853 else if (ada_is_constrained_packed_array_type (type)
854 && TYPE_CODE (type) != TYPE_CODE_PTR)
79d43c61 855 print_array_type (type, stream, show, level, flags);
14f9c5c9 856 else
d2e4a39e
AS
857 switch (TYPE_CODE (type))
858 {
859 default:
860 fprintf_filtered (stream, "<");
79d43c61 861 c_print_type (type, "", stream, show, level, flags);
d2e4a39e
AS
862 fprintf_filtered (stream, ">");
863 break;
864 case TYPE_CODE_PTR:
720d1a40 865 case TYPE_CODE_TYPEDEF:
d2e4a39e 866 fprintf_filtered (stream, "access ");
79d43c61
TT
867 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
868 flags);
d2e4a39e
AS
869 break;
870 case TYPE_CODE_REF:
871 fprintf_filtered (stream, "<ref> ");
79d43c61
TT
872 ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
873 flags);
d2e4a39e
AS
874 break;
875 case TYPE_CODE_ARRAY:
79d43c61 876 print_array_type (type, stream, show, level, flags);
d2e4a39e 877 break;
690cc4eb
PH
878 case TYPE_CODE_BOOL:
879 fprintf_filtered (stream, "(false, true)");
880 break;
d2e4a39e
AS
881 case TYPE_CODE_INT:
882 if (ada_is_fixed_point_type (type))
883 print_fixed_point_type (type, stream);
d2e4a39e
AS
884 else
885 {
0d5cff50 886 const char *name = ada_type_name (type);
5b4ee69b 887
d2e4a39e 888 if (!ada_is_range_type_name (name))
7f6aba03
TT
889 fprintf_styled (stream, metadata_style.style (),
890 _("<%s-byte integer>"),
891 pulongest (TYPE_LENGTH (type)));
d2e4a39e
AS
892 else
893 {
894 fprintf_filtered (stream, "range ");
fb151210 895 print_range_type (type, stream, 1 /* bounds_prefered_p */);
d2e4a39e
AS
896 }
897 }
898 break;
899 case TYPE_CODE_RANGE:
900 if (ada_is_fixed_point_type (type))
901 print_fixed_point_type (type, stream);
d2e4a39e 902 else if (ada_is_modular_type (type))
529cad9c
PH
903 fprintf_filtered (stream, "mod %s",
904 int_string (ada_modulus (type), 10, 0, 0, 1));
d2e4a39e
AS
905 else
906 {
907 fprintf_filtered (stream, "range ");
fb151210 908 print_range (type, stream, 1 /* bounds_prefered_p */);
d2e4a39e
AS
909 }
910 break;
911 case TYPE_CODE_FLT:
7f6aba03
TT
912 fprintf_styled (stream, metadata_style.style (),
913 _("<%s-byte float>"),
914 pulongest (TYPE_LENGTH (type)));
d2e4a39e
AS
915 break;
916 case TYPE_CODE_ENUM:
917 if (show < 0)
918 fprintf_filtered (stream, "(...)");
919 else
920 print_enum_type (type, stream);
921 break;
922 case TYPE_CODE_STRUCT:
4c4b4cd2 923 if (ada_is_array_descriptor_type (type))
79d43c61 924 print_array_type (type, stream, show, level, flags);
d2e4a39e
AS
925 else if (ada_is_bogus_array_descriptor (type))
926 fprintf_filtered (stream,
e1d5a0d2 927 _("array (?) of ? (<mal-formed descriptor>)"));
d2e4a39e 928 else
79d43c61 929 print_record_type (type, stream, show, level, flags);
d2e4a39e
AS
930 break;
931 case TYPE_CODE_UNION:
79d43c61 932 print_unchecked_union_type (type, stream, show, level, flags);
d2e4a39e
AS
933 break;
934 case TYPE_CODE_FUNC:
79d43c61 935 print_func_type (type, stream, varstring, flags);
d2e4a39e
AS
936 break;
937 }
14f9c5c9 938}
be942545
JB
939
940/* Implement the la_print_typedef language method for Ada. */
941
942void
943ada_print_typedef (struct type *type, struct symbol *new_symbol,
944 struct ui_file *stream)
945{
946 type = ada_check_typedef (type);
79d43c61 947 ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
be942545 948}