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