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 "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 "cli/cli-style.h"
  34 #include "typeprint.h"
  35 #include "target-float.h"
  36 #include "ada-lang.h"
  37 #include <ctype.h>
  38
  39 static int print_selected_record_field_types (struct type *, struct type *,
  40                                               int, int,
  41                                               struct ui_file *, int, int,
  42                                               const struct type_print_options *);
  43
  44 static int print_record_field_types (struct type *, struct type *,
  45                                      struct ui_file *, int, int,
  46                                      const struct type_print_options *);
  47 \f
  48
  49
  50 static char *name_buffer;
  51 static int name_buffer_len;
  52
  53 /* The (decoded) Ada name of TYPE.  This value persists until the
  54    next call.  */
  55
  56 static char *
  57 decoded_type_name (struct type *type)
  58 {
  59   if (ada_type_name (type) == NULL)
  60     return NULL;
  61   else
  62     {
  63       const char *raw_name = ada_type_name (type);
  64       char *s, *q;
  65
  66       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  67         {
  68           name_buffer_len = 16 + 2 * strlen (raw_name);
  69           name_buffer = (char *) xrealloc (name_buffer, name_buffer_len);
  70         }
  71       strcpy (name_buffer, raw_name);
  72
  73       s = (char *) strstr (name_buffer, "___");
  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
  84       if (!islower (s[1]))
  85         return NULL;
  86
  87       for (s = q = name_buffer; *s != '\0'; q += 1)
  88         {
  89           if (s[0] == '_' && s[1] == '_')
  90             {
  91               *q = '.';
  92               s += 2;
  93             }
  94           else
  95             {
  96               *q = *s;
  97               s += 1;
  98             }
  99         }
 100       *q = '\0';
 101       return name_buffer;
 102     }
 103 }
 104
 105 /* Return nonzero if TYPE is a subrange type, and its bounds
 106    are identical to the bounds of its subtype.  */
 107
 108 static int
 109 type_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
 120   if (is_dynamic_type (type))
 121     return 0;
 122
 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.  */
 136
 137 static void
 138 print_range (struct type *type, struct ui_file *stream,
 139              int bounds_prefered_p)
 140 {
 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
 158   switch (TYPE_CODE (type))
 159     {
 160     case TYPE_CODE_RANGE:
 161     case TYPE_CODE_ENUM:
 162       {
 163         LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 164         int got_error = 0;
 165
 166         try
 167           {
 168             lo = ada_discrete_type_low_bound (type);
 169             hi = ada_discrete_type_high_bound (type);
 170           }
 171         catch (const gdb_exception_error &e)
 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, "<>");
 179             got_error = 1;
 180           }
 181
 182         if (!got_error)
 183           {
 184             ada_print_scalar (type, lo, stream);
 185             fprintf_filtered (stream, " .. ");
 186             ada_print_scalar (type, hi, stream);
 187           }
 188       }
 189       break;
 190     default:
 191       fprintf_filtered (stream, "%.*s",
 192                         ada_name_prefix_len (TYPE_NAME (type)),
 193                         TYPE_NAME (type));
 194       break;
 195     }
 196 }
 197
 198 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 199    set *N past the bound and its delimiter, if any.  */
 200
 201 static void
 202 print_range_bound (struct type *type, const char *bounds, int *n,
 203                    struct ui_file *stream)
 204 {
 205   LONGEST B;
 206
 207   if (ada_scan_number (bounds, *n, &B, n))
 208     {
 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.
 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,
 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)
 221         type = NULL;
 222       ada_print_scalar (type, B, stream);
 223       if (bounds[*n] == '_')
 224         *n += 2;
 225     }
 226   else
 227     {
 228       int bound_len;
 229       const char *bound = bounds + *n;
 230       const char *pend;
 231
 232       pend = strstr (bound, "__");
 233       if (pend == NULL)
 234         *n += bound_len = strlen (bound);
 235       else
 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
 246    "___U") according to the ___XD conventions.  */
 247
 248 static void
 249 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 250                            const char *suffix, struct ui_file *stream)
 251 {
 252   LONGEST B;
 253   std::string name_buf (name, name_len);
 254   name_buf += suffix;
 255
 256   if (get_int_var_value (name_buf.c_str (), B))
 257     ada_print_scalar (type, B, stream);
 258   else
 259     fprintf_filtered (stream, "?");
 260 }
 261
 262 /* Print RAW_TYPE as a range type, using any bound information
 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).  */
 269
 270 static void
 271 print_range_type (struct type *raw_type, struct ui_file *stream,
 272                   int bounds_prefered_p)
 273 {
 274   const char *name;
 275   struct type *base_type;
 276   const char *subtype_info;
 277
 278   gdb_assert (raw_type != NULL);
 279   name = TYPE_NAME (raw_type);
 280   gdb_assert (name != NULL);
 281
 282   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 283     base_type = TYPE_TARGET_TYPE (raw_type);
 284   else
 285     base_type = raw_type;
 286
 287   subtype_info = strstr (name, "___XD");
 288   if (subtype_info == NULL)
 289     print_range (raw_type, stream, bounds_prefered_p);
 290   else
 291     {
 292       int prefix_len = subtype_info - name;
 293       const char *bounds_str;
 294       int n;
 295
 296       subtype_info += 5;
 297       bounds_str = strchr (subtype_info, '_');
 298       n = 1;
 299
 300       if (*subtype_info == 'L')
 301         {
 302           print_range_bound (base_type, bounds_str, &n, stream);
 303           subtype_info += 1;
 304         }
 305       else
 306         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 307                                    stream);
 308
 309       fprintf_filtered (stream, " .. ");
 310
 311       if (*subtype_info == 'U')
 312         print_range_bound (base_type, bounds_str, &n, stream);
 313       else
 314         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 315                                    stream);
 316     }
 317 }
 318
 319 /* Print enumerated type TYPE on STREAM.  */
 320
 321 static void
 322 print_enum_type (struct type *type, struct ui_file *stream)
 323 {
 324   int len = TYPE_NFIELDS (type);
 325   int i;
 326   LONGEST lastval;
 327
 328   fprintf_filtered (stream, "(");
 329   wrap_here (" ");
 330
 331   lastval = 0;
 332   for (i = 0; i < len; i++)
 333     {
 334       QUIT;
 335       if (i)
 336         fprintf_filtered (stream, ", ");
 337       wrap_here ("    ");
 338       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 339       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 340         {
 341           fprintf_filtered (stream, " => %s",
 342                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 343           lastval = TYPE_FIELD_ENUMVAL (type, i);
 344         }
 345       lastval += 1;
 346     }
 347   fprintf_filtered (stream, ")");
 348 }
 349
 350 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 351
 352 static void
 353 print_fixed_point_type (struct type *type, struct ui_file *stream)
 354 {
 355   struct value *delta = ada_delta (type);
 356   struct value *small = ada_scaling_factor (type);
 357
 358   if (delta == nullptr)
 359     fprintf_filtered (stream, "delta ??");
 360   else
 361     {
 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         }
 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   struct type *elt_type = NULL;
 387
 388   if (ada_is_constrained_packed_array_type (type))
 389     type = ada_coerce_to_simple_array_type (type);
 390
 391   bitsize = 0;
 392   fprintf_filtered (stream, "array (");
 393
 394   if (type == NULL)
 395     {
 396       fprintf_styled (stream, metadata_style.style (),
 397                       _("<undecipherable array type>"));
 398       return;
 399     }
 400
 401   n_indices = -1;
 402   if (ada_is_simple_array_type (type))
 403     {
 404       struct type *range_desc_type;
 405       struct type *arr_type;
 406
 407       range_desc_type = ada_find_parallel_type (type, "___XA");
 408       ada_fixup_array_indexes_type (range_desc_type);
 409
 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))
 415             {
 416               if (arr_type != type)
 417                 fprintf_filtered (stream, ", ");
 418               print_range (TYPE_INDEX_TYPE (arr_type), stream,
 419                            0 /* bounds_prefered_p */);
 420               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 421                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 422             }
 423         }
 424       else
 425         {
 426           int k;
 427
 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),
 436                                 stream, 0 /* bounds_prefered_p */);
 437               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 438                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 439             }
 440         }
 441     }
 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     }
 449
 450   elt_type = ada_array_element_type (type, n_indices);
 451   fprintf_filtered (stream, ") of ");
 452   wrap_here ("");
 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))
 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
 463    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 464    values.  Return non-zero if the field is an encoding of
 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
 467    in types annotated with pragma Unchecked_Variant).  */
 468
 469 static int
 470 print_choices (struct type *type, int field_num, struct ui_file *stream,
 471                struct type *val_type)
 472 {
 473   int have_output;
 474   int p;
 475   const char *name = TYPE_FIELD_NAME (type, field_num);
 476
 477   have_output = 0;
 478
 479   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 480   if (name[0] == 'V')
 481     {
 482       if (!ada_scan_number (name, 1, NULL, &p))
 483         goto Huh;
 484     }
 485   else
 486     p = 0;
 487
 488   while (1)
 489     {
 490       switch (name[p])
 491         {
 492         default:
 493           goto Huh;
 494         case '_':
 495         case '\0':
 496           fprintf_filtered (stream, " =>");
 497           return 1;
 498         case 'S':
 499         case 'R':
 500         case 'O':
 501           if (have_output)
 502             fprintf_filtered (stream, " | ");
 503           have_output = 1;
 504           break;
 505         }
 506
 507       switch (name[p])
 508         {
 509         case 'S':
 510           {
 511             LONGEST W;
 512
 513             if (!ada_scan_number (name, p + 1, &W, &p))
 514               goto Huh;
 515             ada_print_scalar (val_type, W, stream);
 516             break;
 517           }
 518         case 'R':
 519           {
 520             LONGEST L, U;
 521
 522             if (!ada_scan_number (name, p + 1, &L, &p)
 523                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 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
 537 Huh:
 538   fprintf_filtered (stream, "?? =>");
 539   return 0;
 540 }
 541
 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.  */
 549
 550 static void
 551 print_variant_clauses (struct type *type, int field_num,
 552                        struct type *outer_type, struct ui_file *stream,
 553                        int show, int level,
 554                        const struct type_print_options *flags)
 555 {
 556   int i;
 557   struct type *var_type, *par_type;
 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);
 566       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 567         return;
 568     }
 569
 570   par_type = ada_find_parallel_type (var_type, "___XVU");
 571   if (par_type != NULL)
 572     var_type = par_type;
 573
 574   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 575     {
 576       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 577       if (print_choices (var_type, i, stream, discr_type))
 578         {
 579           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 580                                         outer_type, stream, show, level + 4,
 581                                         flags)
 582               <= 0)
 583             fprintf_filtered (stream, " null;");
 584         }
 585       else
 586         print_selected_record_field_types (var_type, outer_type, i, i,
 587                                            stream, show, level + 4, flags);
 588     }
 589 }
 590
 591 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 592    discriminants are contained in OUTER_TYPE, print a description of it
 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.  */
 598
 599 static void
 600 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 601                     struct ui_file *stream, int show, int level,
 602                     const struct type_print_options *flags)
 603 {
 604   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 605                     ada_variant_discrim_name
 606                     (TYPE_FIELD_TYPE (type, field_num)));
 607   print_variant_clauses (type, field_num, outer_type, stream, show,
 608                          level + 4, flags);
 609   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 610 }
 611
 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
 617    not print parent type information of TYPE.  Returns 0 if no fields
 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.  */
 620
 621 static int
 622 print_selected_record_field_types (struct type *type, struct type *outer_type,
 623                                    int fld0, int fld1,
 624                                    struct ui_file *stream, int show, int level,
 625                                    const struct type_print_options *flags)
 626 {
 627   int i, flds;
 628
 629   flds = 0;
 630
 631   if (fld0 > fld1 && TYPE_STUB (type))
 632     return -1;
 633
 634   for (i = fld0; i <= fld1; i += 1)
 635     {
 636       QUIT;
 637
 638       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 639         ;
 640       else if (ada_is_wrapper_field (type, i))
 641         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 642                                           stream, show, level, flags);
 643       else if (ada_is_variant_part (type, i))
 644         {
 645           print_variant_part (type, i, outer_type, stream, show, level, flags);
 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),
 654                           stream, show - 1, level + 4, flags);
 655           fprintf_filtered (stream, ";");
 656         }
 657     }
 658
 659   return flds;
 660 }
 661
 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
 665 static int
 666 print_record_field_types (struct type *type, struct type *outer_type,
 667                           struct ui_file *stream, int show, int level,
 668                           const struct type_print_options *flags)
 669 {
 670   return print_selected_record_field_types (type, outer_type,
 671                                             0, TYPE_NFIELDS (type) - 1,
 672                                             stream, show, level, flags);
 673 }
 674
 675
 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).  */
 679
 680 static void
 681 print_record_type (struct type *type0, struct ui_file *stream, int show,
 682                    int level, const struct type_print_options *flags)
 683 {
 684   struct type *parent_type;
 685   struct type *type;
 686
 687   type = ada_find_parallel_type (type0, "___XVE");
 688   if (type == NULL)
 689     type = type0;
 690
 691   parent_type = ada_parent_type (type);
 692   if (ada_type_name (parent_type) != NULL)
 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     }
 704   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 705     fprintf_filtered (stream, "tagged record");
 706   else
 707     fprintf_filtered (stream, "record");
 708
 709   if (show < 0)
 710     fprintf_filtered (stream, " ... end record");
 711   else
 712     {
 713       int flds;
 714
 715       flds = 0;
 716       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 717         flds += print_record_field_types (parent_type, parent_type,
 718                                           stream, show, level, flags);
 719       flds += print_record_field_types (type, type, stream, show, level,
 720                                         flags);
 721
 722       if (flds > 0)
 723         fprintf_filtered (stream, "\n%*send record", level, "");
 724       else if (flds < 0)
 725         fprintf_filtered (stream, _(" <incomplete type> end record"));
 726       else
 727         fprintf_filtered (stream, " null; end record");
 728     }
 729 }
 730
 731 /* Print the unchecked union type TYPE in something resembling Ada
 732    format on STREAM.  LEVEL is the recursion (indentation) level
 733    in case the element type itself has nested structure, and SHOW is the
 734    number of levels of internal structure to show (see ada_print_type).  */
 735 static void
 736 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 737                             int show, int level,
 738                             const struct type_print_options *flags)
 739 {
 740   if (show < 0)
 741     fprintf_filtered (stream, "record (?) is ... end record");
 742   else if (TYPE_NFIELDS (type) == 0)
 743     fprintf_filtered (stream, "record (?) is null; end record");
 744   else
 745     {
 746       int i;
 747
 748       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 749
 750       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 751         {
 752           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 753                             level + 12, "");
 754           ada_print_type (TYPE_FIELD_TYPE (type, i),
 755                           TYPE_FIELD_NAME (type, i),
 756                           stream, show - 1, level + 12, flags);
 757           fprintf_filtered (stream, ";");
 758         }
 759
 760       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 761                         level + 4, "", level, "");
 762     }
 763 }
 764
 765
 766
 767 /* Print function or procedure type TYPE on STREAM.  Make it a header
 768    for function or procedure NAME if NAME is not null.  */
 769
 770 static void
 771 print_func_type (struct type *type, struct ui_file *stream, const char *name,
 772                  const struct type_print_options *flags)
 773 {
 774   int i, len = TYPE_NFIELDS (type);
 775
 776   if (TYPE_TARGET_TYPE (type) != NULL
 777       && TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 778     fprintf_filtered (stream, "procedure");
 779   else
 780     fprintf_filtered (stream, "function");
 781
 782   if (name != NULL && name[0] != '\0')
 783     {
 784       fputs_filtered (" ", stream);
 785       fputs_styled (name, function_name_style.style (), stream);
 786     }
 787
 788   if (len > 0)
 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             }
 798           fprintf_filtered (stream, "a%d: ", i + 1);
 799           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 800                           flags);
 801         }
 802       fprintf_filtered (stream, ")");
 803     }
 804
 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)
 808     {
 809       fprintf_filtered (stream, " return ");
 810       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 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.
 819    SHOW+1 is the maximum number of levels of internal type structure
 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
 823       when there is a type name for the SHOWth deepest level (0th is
 824       outer level).
 825    When SHOW<0, no inner structure is shown.
 826    LEVEL indicates level of recursion (for nested definitions).  */
 827
 828 void
 829 ada_print_type (struct type *type0, const char *varstring,
 830                 struct ui_file *stream, int show, int level,
 831                 const struct type_print_options *flags)
 832 {
 833   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 834   char *type_name = decoded_type_name (type0);
 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: ",
 841                           ada_name_prefix_len (varstring), varstring);
 842       fprintf_styled (stream, metadata_style.style (), "<null type?>");
 843       return;
 844     }
 845
 846   if (show > 0)
 847     type = ada_check_typedef (type);
 848
 849   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 850     fprintf_filtered (stream, "%.*s: ",
 851                       ada_name_prefix_len (varstring), varstring);
 852
 853   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 854     {
 855       fprintf_filtered (stream, "%.*s",
 856                         ada_name_prefix_len (type_name), type_name);
 857       return;
 858     }
 859
 860   if (ada_is_aligner_type (type))
 861     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 862   else if (ada_is_constrained_packed_array_type (type)
 863            && TYPE_CODE (type) != TYPE_CODE_PTR)
 864     print_array_type (type, stream, show, level, flags);
 865   else
 866     switch (TYPE_CODE (type))
 867       {
 868       default:
 869         fprintf_filtered (stream, "<");
 870         c_print_type (type, "", stream, show, level, flags);
 871         fprintf_filtered (stream, ">");
 872         break;
 873       case TYPE_CODE_PTR:
 874       case TYPE_CODE_TYPEDEF:
 875         fprintf_filtered (stream, "access ");
 876         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 877                         flags);
 878         break;
 879       case TYPE_CODE_REF:
 880         fprintf_filtered (stream, "<ref> ");
 881         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 882                         flags);
 883         break;
 884       case TYPE_CODE_ARRAY:
 885         print_array_type (type, stream, show, level, flags);
 886         break;
 887       case TYPE_CODE_BOOL:
 888         fprintf_filtered (stream, "(false, true)");
 889         break;
 890       case TYPE_CODE_INT:
 891         if (ada_is_fixed_point_type (type))
 892           print_fixed_point_type (type, stream);
 893         else
 894           {
 895             const char *name = ada_type_name (type);
 896
 897             if (!ada_is_range_type_name (name))
 898               fprintf_styled (stream, metadata_style.style (),
 899                               _("<%s-byte integer>"),
 900                               pulongest (TYPE_LENGTH (type)));
 901             else
 902               {
 903                 fprintf_filtered (stream, "range ");
 904                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 905               }
 906           }
 907         break;
 908       case TYPE_CODE_RANGE:
 909         if (ada_is_fixed_point_type (type))
 910           print_fixed_point_type (type, stream);
 911         else if (ada_is_modular_type (type))
 912           fprintf_filtered (stream, "mod %s",
 913                             int_string (ada_modulus (type), 10, 0, 0, 1));
 914         else
 915           {
 916             fprintf_filtered (stream, "range ");
 917             print_range (type, stream, 1 /* bounds_prefered_p */);
 918           }
 919         break;
 920       case TYPE_CODE_FLT:
 921         fprintf_styled (stream, metadata_style.style (),
 922                         _("<%s-byte float>"),
 923                         pulongest (TYPE_LENGTH (type)));
 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:
 932         if (ada_is_array_descriptor_type (type))
 933           print_array_type (type, stream, show, level, flags);
 934         else if (ada_is_bogus_array_descriptor (type))
 935           fprintf_filtered (stream,
 936                             _("array (?) of ? (<mal-formed descriptor>)"));
 937         else
 938           print_record_type (type, stream, show, level, flags);
 939         break;
 940       case TYPE_CODE_UNION:
 941         print_unchecked_union_type (type, stream, show, level, flags);
 942         break;
 943       case TYPE_CODE_FUNC:
 944         print_func_type (type, stream, varstring, flags);
 945         break;
 946       }
 947 }
 948
 949 /* Implement the la_print_typedef language method for Ada.  */
 950
 951 void
 952 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 953                    struct ui_file *stream)
 954 {
 955   type = ada_check_typedef (type);
 956   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 957   fprintf_filtered (stream, "\n");
 958 }