gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986-2019 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 "bfd.h"                /* Binary File Description */
  21 #include "gdbtypes.h"
  22 #include "value.h"
  23 #include "c-lang.h"
  24 #include "cli/cli-style.h"
  25 #include "typeprint.h"
  26 #include "target-float.h"
  27 #include "ada-lang.h"
  28 #include <ctype.h>
  29
  30 static int print_selected_record_field_types (struct type *, struct type *,
  31                                               int, int,
  32                                               struct ui_file *, int, int,
  33                                               const struct type_print_options *);
  34
  35 static int print_record_field_types (struct type *, struct type *,
  36                                      struct ui_file *, int, int,
  37                                      const struct type_print_options *);
  38 \f
  39
  40
  41 static char *name_buffer;
  42 static int name_buffer_len;
  43
  44 /* The (decoded) Ada name of TYPE.  This value persists until the
  45    next call.  */
  46
  47 static char *
  48 decoded_type_name (struct type *type)
  49 {
  50   if (ada_type_name (type) == NULL)
  51     return NULL;
  52   else
  53     {
  54       const char *raw_name = ada_type_name (type);
  55       char *s, *q;
  56
  57       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  58         {
  59           name_buffer_len = 16 + 2 * strlen (raw_name);
  60           name_buffer = (char *) xrealloc (name_buffer, name_buffer_len);
  61         }
  62       strcpy (name_buffer, raw_name);
  63
  64       s = (char *) strstr (name_buffer, "___");
  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
  75       if (!islower (s[1]))
  76         return NULL;
  77
  78       for (s = q = name_buffer; *s != '\0'; q += 1)
  79         {
  80           if (s[0] == '_' && s[1] == '_')
  81             {
  82               *q = '.';
  83               s += 2;
  84             }
  85           else
  86             {
  87               *q = *s;
  88               s += 1;
  89             }
  90         }
  91       *q = '\0';
  92       return name_buffer;
  93     }
  94 }
  95
  96 /* Return nonzero if TYPE is a subrange type, and its bounds
  97    are identical to the bounds of its subtype.  */
  98
  99 static int
 100 type_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
 111   if (is_dynamic_type (type))
 112     return 0;
 113
 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.  */
 127
 128 static void
 129 print_range (struct type *type, struct ui_file *stream,
 130              int bounds_prefered_p)
 131 {
 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
 149   switch (TYPE_CODE (type))
 150     {
 151     case TYPE_CODE_RANGE:
 152     case TYPE_CODE_ENUM:
 153       {
 154         LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 155         int got_error = 0;
 156
 157         try
 158           {
 159             lo = ada_discrete_type_low_bound (type);
 160             hi = ada_discrete_type_high_bound (type);
 161           }
 162         catch (const gdb_exception_error &e)
 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, "<>");
 170             got_error = 1;
 171           }
 172
 173         if (!got_error)
 174           {
 175             ada_print_scalar (type, lo, stream);
 176             fprintf_filtered (stream, " .. ");
 177             ada_print_scalar (type, hi, stream);
 178           }
 179       }
 180       break;
 181     default:
 182       fprintf_filtered (stream, "%.*s",
 183                         ada_name_prefix_len (TYPE_NAME (type)),
 184                         TYPE_NAME (type));
 185       break;
 186     }
 187 }
 188
 189 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 190    set *N past the bound and its delimiter, if any.  */
 191
 192 static void
 193 print_range_bound (struct type *type, const char *bounds, int *n,
 194                    struct ui_file *stream)
 195 {
 196   LONGEST B;
 197
 198   if (ada_scan_number (bounds, *n, &B, n))
 199     {
 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.
 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,
 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)
 212         type = NULL;
 213       ada_print_scalar (type, B, stream);
 214       if (bounds[*n] == '_')
 215         *n += 2;
 216     }
 217   else
 218     {
 219       int bound_len;
 220       const char *bound = bounds + *n;
 221       const char *pend;
 222
 223       pend = strstr (bound, "__");
 224       if (pend == NULL)
 225         *n += bound_len = strlen (bound);
 226       else
 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
 237    "___U") according to the ___XD conventions.  */
 238
 239 static void
 240 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 241                            const char *suffix, struct ui_file *stream)
 242 {
 243   LONGEST B;
 244   std::string name_buf (name, name_len);
 245   name_buf += suffix;
 246
 247   if (get_int_var_value (name_buf.c_str (), B))
 248     ada_print_scalar (type, B, stream);
 249   else
 250     fprintf_filtered (stream, "?");
 251 }
 252
 253 /* Print RAW_TYPE as a range type, using any bound information
 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).  */
 260
 261 static void
 262 print_range_type (struct type *raw_type, struct ui_file *stream,
 263                   int bounds_prefered_p)
 264 {
 265   const char *name;
 266   struct type *base_type;
 267   const char *subtype_info;
 268
 269   gdb_assert (raw_type != NULL);
 270   name = TYPE_NAME (raw_type);
 271   gdb_assert (name != NULL);
 272
 273   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 274     base_type = TYPE_TARGET_TYPE (raw_type);
 275   else
 276     base_type = raw_type;
 277
 278   subtype_info = strstr (name, "___XD");
 279   if (subtype_info == NULL)
 280     print_range (raw_type, stream, bounds_prefered_p);
 281   else
 282     {
 283       int prefix_len = subtype_info - name;
 284       const char *bounds_str;
 285       int n;
 286
 287       subtype_info += 5;
 288       bounds_str = strchr (subtype_info, '_');
 289       n = 1;
 290
 291       if (*subtype_info == 'L')
 292         {
 293           print_range_bound (base_type, bounds_str, &n, stream);
 294           subtype_info += 1;
 295         }
 296       else
 297         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 298                                    stream);
 299
 300       fprintf_filtered (stream, " .. ");
 301
 302       if (*subtype_info == 'U')
 303         print_range_bound (base_type, bounds_str, &n, stream);
 304       else
 305         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 306                                    stream);
 307     }
 308 }
 309
 310 /* Print enumerated type TYPE on STREAM.  */
 311
 312 static void
 313 print_enum_type (struct type *type, struct ui_file *stream)
 314 {
 315   int len = TYPE_NFIELDS (type);
 316   int i;
 317   LONGEST lastval;
 318
 319   fprintf_filtered (stream, "(");
 320   wrap_here (" ");
 321
 322   lastval = 0;
 323   for (i = 0; i < len; i++)
 324     {
 325       QUIT;
 326       if (i)
 327         fprintf_filtered (stream, ", ");
 328       wrap_here ("    ");
 329       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 330       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 331         {
 332           fprintf_filtered (stream, " => %s",
 333                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 334           lastval = TYPE_FIELD_ENUMVAL (type, i);
 335         }
 336       lastval += 1;
 337     }
 338   fprintf_filtered (stream, ")");
 339 }
 340
 341 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 342
 343 static void
 344 print_fixed_point_type (struct type *type, struct ui_file *stream)
 345 {
 346   struct value *delta = ada_delta (type);
 347   struct value *small = ada_scaling_factor (type);
 348
 349   if (delta == nullptr)
 350     fprintf_filtered (stream, "delta ??");
 351   else
 352     {
 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         }
 363     }
 364 }
 365
 366 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 367    recursion (indentation) level, in case the element type itself has
 368    nested structure, and SHOW is the number of levels of internal
 369    structure to show (see ada_print_type).  */
 370
 371 static void
 372 print_array_type (struct type *type, struct ui_file *stream, int show,
 373                   int level, const struct type_print_options *flags)
 374 {
 375   int bitsize;
 376   int n_indices;
 377   struct type *elt_type = NULL;
 378
 379   if (ada_is_constrained_packed_array_type (type))
 380     type = ada_coerce_to_simple_array_type (type);
 381
 382   bitsize = 0;
 383   fprintf_filtered (stream, "array (");
 384
 385   if (type == NULL)
 386     {
 387       fprintf_styled (stream, metadata_style.style (),
 388                       _("<undecipherable array type>"));
 389       return;
 390     }
 391
 392   n_indices = -1;
 393   if (ada_is_simple_array_type (type))
 394     {
 395       struct type *range_desc_type;
 396       struct type *arr_type;
 397
 398       range_desc_type = ada_find_parallel_type (type, "___XA");
 399       ada_fixup_array_indexes_type (range_desc_type);
 400
 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))
 406             {
 407               if (arr_type != type)
 408                 fprintf_filtered (stream, ", ");
 409               print_range (TYPE_INDEX_TYPE (arr_type), stream,
 410                            0 /* bounds_prefered_p */);
 411               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 412                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 413             }
 414         }
 415       else
 416         {
 417           int k;
 418
 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),
 427                                 stream, 0 /* bounds_prefered_p */);
 428               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 429                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 430             }
 431         }
 432     }
 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     }
 440
 441   elt_type = ada_array_element_type (type, n_indices);
 442   fprintf_filtered (stream, ") of ");
 443   wrap_here ("");
 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))
 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
 454    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 455    values.  Return non-zero if the field is an encoding of
 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
 458    in types annotated with pragma Unchecked_Variant).  */
 459
 460 static int
 461 print_choices (struct type *type, int field_num, struct ui_file *stream,
 462                struct type *val_type)
 463 {
 464   int have_output;
 465   int p;
 466   const char *name = TYPE_FIELD_NAME (type, field_num);
 467
 468   have_output = 0;
 469
 470   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 471   if (name[0] == 'V')
 472     {
 473       if (!ada_scan_number (name, 1, NULL, &p))
 474         goto Huh;
 475     }
 476   else
 477     p = 0;
 478
 479   while (1)
 480     {
 481       switch (name[p])
 482         {
 483         default:
 484           goto Huh;
 485         case '_':
 486         case '\0':
 487           fprintf_filtered (stream, " =>");
 488           return 1;
 489         case 'S':
 490         case 'R':
 491         case 'O':
 492           if (have_output)
 493             fprintf_filtered (stream, " | ");
 494           have_output = 1;
 495           break;
 496         }
 497
 498       switch (name[p])
 499         {
 500         case 'S':
 501           {
 502             LONGEST W;
 503
 504             if (!ada_scan_number (name, p + 1, &W, &p))
 505               goto Huh;
 506             ada_print_scalar (val_type, W, stream);
 507             break;
 508           }
 509         case 'R':
 510           {
 511             LONGEST L, U;
 512
 513             if (!ada_scan_number (name, p + 1, &L, &p)
 514                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 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
 528 Huh:
 529   fprintf_filtered (stream, "?? =>");
 530   return 0;
 531 }
 532
 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.  */
 540
 541 static void
 542 print_variant_clauses (struct type *type, int field_num,
 543                        struct type *outer_type, struct ui_file *stream,
 544                        int show, int level,
 545                        const struct type_print_options *flags)
 546 {
 547   int i;
 548   struct type *var_type, *par_type;
 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);
 557       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 558         return;
 559     }
 560
 561   par_type = ada_find_parallel_type (var_type, "___XVU");
 562   if (par_type != NULL)
 563     var_type = par_type;
 564
 565   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 566     {
 567       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 568       if (print_choices (var_type, i, stream, discr_type))
 569         {
 570           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 571                                         outer_type, stream, show, level + 4,
 572                                         flags)
 573               <= 0)
 574             fprintf_filtered (stream, " null;");
 575         }
 576       else
 577         print_selected_record_field_types (var_type, outer_type, i, i,
 578                                            stream, show, level + 4, flags);
 579     }
 580 }
 581
 582 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 583    discriminants are contained in OUTER_TYPE, print a description of it
 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.  */
 589
 590 static void
 591 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 592                     struct ui_file *stream, int show, int level,
 593                     const struct type_print_options *flags)
 594 {
 595   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 596                     ada_variant_discrim_name
 597                     (TYPE_FIELD_TYPE (type, field_num)));
 598   print_variant_clauses (type, field_num, outer_type, stream, show,
 599                          level + 4, flags);
 600   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 601 }
 602
 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
 608    not print parent type information of TYPE.  Returns 0 if no fields
 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.  */
 611
 612 static int
 613 print_selected_record_field_types (struct type *type, struct type *outer_type,
 614                                    int fld0, int fld1,
 615                                    struct ui_file *stream, int show, int level,
 616                                    const struct type_print_options *flags)
 617 {
 618   int i, flds;
 619
 620   flds = 0;
 621
 622   if (fld0 > fld1 && TYPE_STUB (type))
 623     return -1;
 624
 625   for (i = fld0; i <= fld1; i += 1)
 626     {
 627       QUIT;
 628
 629       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 630         ;
 631       else if (ada_is_wrapper_field (type, i))
 632         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 633                                           stream, show, level, flags);
 634       else if (ada_is_variant_part (type, i))
 635         {
 636           print_variant_part (type, i, outer_type, stream, show, level, flags);
 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),
 645                           stream, show - 1, level + 4, flags);
 646           fprintf_filtered (stream, ";");
 647         }
 648     }
 649
 650   return flds;
 651 }
 652
 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
 656 static int
 657 print_record_field_types (struct type *type, struct type *outer_type,
 658                           struct ui_file *stream, int show, int level,
 659                           const struct type_print_options *flags)
 660 {
 661   return print_selected_record_field_types (type, outer_type,
 662                                             0, TYPE_NFIELDS (type) - 1,
 663                                             stream, show, level, flags);
 664 }
 665
 666
 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).  */
 670
 671 static void
 672 print_record_type (struct type *type0, struct ui_file *stream, int show,
 673                    int level, const struct type_print_options *flags)
 674 {
 675   struct type *parent_type;
 676   struct type *type;
 677
 678   type = ada_find_parallel_type (type0, "___XVE");
 679   if (type == NULL)
 680     type = type0;
 681
 682   parent_type = ada_parent_type (type);
 683   if (ada_type_name (parent_type) != NULL)
 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     }
 695   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 696     fprintf_filtered (stream, "tagged record");
 697   else
 698     fprintf_filtered (stream, "record");
 699
 700   if (show < 0)
 701     fprintf_filtered (stream, " ... end record");
 702   else
 703     {
 704       int flds;
 705
 706       flds = 0;
 707       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 708         flds += print_record_field_types (parent_type, parent_type,
 709                                           stream, show, level, flags);
 710       flds += print_record_field_types (type, type, stream, show, level,
 711                                         flags);
 712
 713       if (flds > 0)
 714         fprintf_filtered (stream, "\n%*send record", level, "");
 715       else if (flds < 0)
 716         fprintf_filtered (stream, _(" <incomplete type> end record"));
 717       else
 718         fprintf_filtered (stream, " null; end record");
 719     }
 720 }
 721
 722 /* Print the unchecked union type TYPE in something resembling Ada
 723    format on STREAM.  LEVEL is the recursion (indentation) level
 724    in case the element type itself has nested structure, and SHOW is the
 725    number of levels of internal structure to show (see ada_print_type).  */
 726 static void
 727 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 728                             int show, int level,
 729                             const struct type_print_options *flags)
 730 {
 731   if (show < 0)
 732     fprintf_filtered (stream, "record (?) is ... end record");
 733   else if (TYPE_NFIELDS (type) == 0)
 734     fprintf_filtered (stream, "record (?) is null; end record");
 735   else
 736     {
 737       int i;
 738
 739       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 740
 741       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 742         {
 743           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 744                             level + 12, "");
 745           ada_print_type (TYPE_FIELD_TYPE (type, i),
 746                           TYPE_FIELD_NAME (type, i),
 747                           stream, show - 1, level + 12, flags);
 748           fprintf_filtered (stream, ";");
 749         }
 750
 751       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 752                         level + 4, "", level, "");
 753     }
 754 }
 755
 756
 757
 758 /* Print function or procedure type TYPE on STREAM.  Make it a header
 759    for function or procedure NAME if NAME is not null.  */
 760
 761 static void
 762 print_func_type (struct type *type, struct ui_file *stream, const char *name,
 763                  const struct type_print_options *flags)
 764 {
 765   int i, len = TYPE_NFIELDS (type);
 766
 767   if (TYPE_TARGET_TYPE (type) != NULL
 768       && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 769     fprintf_filtered (stream, "procedure");
 770   else
 771     fprintf_filtered (stream, "function");
 772
 773   if (name != NULL && name[0] != '\0')
 774     {
 775       fputs_filtered (" ", stream);
 776       fputs_styled (name, function_name_style.style (), stream);
 777     }
 778
 779   if (len > 0)
 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             }
 789           fprintf_filtered (stream, "a%d: ", i + 1);
 790           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 791                           flags);
 792         }
 793       fprintf_filtered (stream, ")");
 794     }
 795
 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)
 799     {
 800       fprintf_filtered (stream, " return ");
 801       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 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.
 810    SHOW+1 is the maximum number of levels of internal type structure
 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
 814       when there is a type name for the SHOWth deepest level (0th is
 815       outer level).
 816    When SHOW<0, no inner structure is shown.
 817    LEVEL indicates level of recursion (for nested definitions).  */
 818
 819 void
 820 ada_print_type (struct type *type0, const char *varstring,
 821                 struct ui_file *stream, int show, int level,
 822                 const struct type_print_options *flags)
 823 {
 824   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 825   char *type_name = decoded_type_name (type0);
 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: ",
 832                           ada_name_prefix_len (varstring), varstring);
 833       fprintf_styled (stream, metadata_style.style (), "<null type?>");
 834       return;
 835     }
 836
 837   if (show > 0)
 838     type = ada_check_typedef (type);
 839
 840   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 841     fprintf_filtered (stream, "%.*s: ",
 842                       ada_name_prefix_len (varstring), varstring);
 843
 844   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 845     {
 846       fprintf_filtered (stream, "%.*s",
 847                         ada_name_prefix_len (type_name), type_name);
 848       return;
 849     }
 850
 851   if (ada_is_aligner_type (type))
 852     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 853   else if (ada_is_constrained_packed_array_type (type)
 854            && TYPE_CODE (type) != TYPE_CODE_PTR)
 855     print_array_type (type, stream, show, level, flags);
 856   else
 857     switch (TYPE_CODE (type))
 858       {
 859       default:
 860         fprintf_filtered (stream, "<");
 861         c_print_type (type, "", stream, show, level, flags);
 862         fprintf_filtered (stream, ">");
 863         break;
 864       case TYPE_CODE_PTR:
 865       case TYPE_CODE_TYPEDEF:
 866         fprintf_filtered (stream, "access ");
 867         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 868                         flags);
 869         break;
 870       case TYPE_CODE_REF:
 871         fprintf_filtered (stream, "<ref> ");
 872         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 873                         flags);
 874         break;
 875       case TYPE_CODE_ARRAY:
 876         print_array_type (type, stream, show, level, flags);
 877         break;
 878       case TYPE_CODE_BOOL:
 879         fprintf_filtered (stream, "(false, true)");
 880         break;
 881       case TYPE_CODE_INT:
 882         if (ada_is_fixed_point_type (type))
 883           print_fixed_point_type (type, stream);
 884         else
 885           {
 886             const char *name = ada_type_name (type);
 887
 888             if (!ada_is_range_type_name (name))
 889               fprintf_styled (stream, metadata_style.style (),
 890                               _("<%s-byte integer>"),
 891                               pulongest (TYPE_LENGTH (type)));
 892             else
 893               {
 894                 fprintf_filtered (stream, "range ");
 895                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 896               }
 897           }
 898         break;
 899       case TYPE_CODE_RANGE:
 900         if (ada_is_fixed_point_type (type))
 901           print_fixed_point_type (type, stream);
 902         else if (ada_is_modular_type (type))
 903           fprintf_filtered (stream, "mod %s",
 904                             int_string (ada_modulus (type), 10, 0, 0, 1));
 905         else
 906           {
 907             fprintf_filtered (stream, "range ");
 908             print_range (type, stream, 1 /* bounds_prefered_p */);
 909           }
 910         break;
 911       case TYPE_CODE_FLT:
 912         fprintf_styled (stream, metadata_style.style (),
 913                         _("<%s-byte float>"),
 914                         pulongest (TYPE_LENGTH (type)));
 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:
 923         if (ada_is_array_descriptor_type (type))
 924           print_array_type (type, stream, show, level, flags);
 925         else if (ada_is_bogus_array_descriptor (type))
 926           fprintf_filtered (stream,
 927                             _("array (?) of ? (<mal-formed descriptor>)"));
 928         else
 929           print_record_type (type, stream, show, level, flags);
 930         break;
 931       case TYPE_CODE_UNION:
 932         print_unchecked_union_type (type, stream, show, level, flags);
 933         break;
 934       case TYPE_CODE_FUNC:
 935         print_func_type (type, stream, varstring, flags);
 936         break;
 937       }
 938 }
 939
 940 /* Implement the la_print_typedef language method for Ada.  */
 941
 942 void
 943 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 944                    struct ui_file *stream)
 945 {
 946   type = ada_check_typedef (type);
 947   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 948 }