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