gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986-2017 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 = (char *) 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         LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 163         int got_error = 0;
 164
 165         target_type = TYPE_TARGET_TYPE (type);
 166         if (target_type == NULL)
 167           target_type = type;
 168
 169         TRY
 170           {
 171             lo = ada_discrete_type_low_bound (type);
 172             hi = ada_discrete_type_high_bound (type);
 173           }
 174         CATCH (e, RETURN_MASK_ERROR)
 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             got_error = 1;
 183           }
 184         END_CATCH
 185
 186         if (!got_error)
 187           {
 188             ada_print_scalar (target_type, lo, stream);
 189             fprintf_filtered (stream, " .. ");
 190             ada_print_scalar (target_type, hi, stream);
 191           }
 192       }
 193       break;
 194     default:
 195       fprintf_filtered (stream, "%.*s",
 196                         ada_name_prefix_len (TYPE_NAME (type)),
 197                         TYPE_NAME (type));
 198       break;
 199     }
 200 }
 201
 202 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 203    set *N past the bound and its delimiter, if any.  */
 204
 205 static void
 206 print_range_bound (struct type *type, const char *bounds, int *n,
 207                    struct ui_file *stream)
 208 {
 209   LONGEST B;
 210
 211   if (ada_scan_number (bounds, *n, &B, n))
 212     {
 213       /* STABS decodes all range types which bounds are 0 .. -1 as
 214          unsigned integers (ie. the type code is TYPE_CODE_INT, not
 215          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
 216          on the unsigned flag to determine whether the bound should
 217          be printed as a signed or an unsigned value.  This causes
 218          the upper bound of the 0 .. -1 range types to be printed as
 219          a very large unsigned number instead of -1.
 220          To workaround this stabs deficiency, we replace the TYPE by NULL
 221          to indicate default output when we detect that the bound is negative,
 222          and the type is a TYPE_CODE_INT.  The bound is negative when
 223          'm' is the last character of the number scanned in BOUNDS.  */
 224       if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
 225         type = NULL;
 226       ada_print_scalar (type, B, stream);
 227       if (bounds[*n] == '_')
 228         *n += 2;
 229     }
 230   else
 231     {
 232       int bound_len;
 233       const char *bound = bounds + *n;
 234       const char *pend;
 235
 236       pend = strstr (bound, "__");
 237       if (pend == NULL)
 238         *n += bound_len = strlen (bound);
 239       else
 240         {
 241           bound_len = pend - bound;
 242           *n += bound_len + 2;
 243         }
 244       fprintf_filtered (stream, "%.*s", bound_len, bound);
 245     }
 246 }
 247
 248 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 249    the value (if found) of the bound indicated by SUFFIX ("___L" or
 250    "___U") according to the ___XD conventions.  */
 251
 252 static void
 253 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 254                            const char *suffix, struct ui_file *stream)
 255 {
 256   static char *name_buf = NULL;
 257   static size_t name_buf_len = 0;
 258   LONGEST B;
 259
 260   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
 261   strncpy (name_buf, name, name_len);
 262   strcpy (name_buf + name_len, suffix);
 263
 264   if (get_int_var_value (name_buf, B))
 265     ada_print_scalar (type, B, stream);
 266   else
 267     fprintf_filtered (stream, "?");
 268 }
 269
 270 /* Print RAW_TYPE as a range type, using any bound information
 271    following the GNAT encoding (if available).
 272
 273    If BOUNDS_PREFERED_P is nonzero, force the printing of the range
 274    using its bounds.  Otherwise, try printing the range without
 275    printing the value of the bounds, if possible (this is only
 276    considered a hint, not a guaranty).  */
 277
 278 static void
 279 print_range_type (struct type *raw_type, struct ui_file *stream,
 280                   int bounds_prefered_p)
 281 {
 282   const char *name;
 283   struct type *base_type;
 284   const char *subtype_info;
 285
 286   gdb_assert (raw_type != NULL);
 287   name = TYPE_NAME (raw_type);
 288   gdb_assert (name != NULL);
 289
 290   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 291     base_type = TYPE_TARGET_TYPE (raw_type);
 292   else
 293     base_type = raw_type;
 294
 295   subtype_info = strstr (name, "___XD");
 296   if (subtype_info == NULL)
 297     print_range (raw_type, stream, bounds_prefered_p);
 298   else
 299     {
 300       int prefix_len = subtype_info - name;
 301       const char *bounds_str;
 302       int n;
 303
 304       subtype_info += 5;
 305       bounds_str = strchr (subtype_info, '_');
 306       n = 1;
 307
 308       if (*subtype_info == 'L')
 309         {
 310           print_range_bound (base_type, bounds_str, &n, stream);
 311           subtype_info += 1;
 312         }
 313       else
 314         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 315                                    stream);
 316
 317       fprintf_filtered (stream, " .. ");
 318
 319       if (*subtype_info == 'U')
 320         print_range_bound (base_type, bounds_str, &n, stream);
 321       else
 322         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 323                                    stream);
 324     }
 325 }
 326
 327 /* Print enumerated type TYPE on STREAM.  */
 328
 329 static void
 330 print_enum_type (struct type *type, struct ui_file *stream)
 331 {
 332   int len = TYPE_NFIELDS (type);
 333   int i;
 334   LONGEST lastval;
 335
 336   fprintf_filtered (stream, "(");
 337   wrap_here (" ");
 338
 339   lastval = 0;
 340   for (i = 0; i < len; i++)
 341     {
 342       QUIT;
 343       if (i)
 344         fprintf_filtered (stream, ", ");
 345       wrap_here ("    ");
 346       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 347       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 348         {
 349           fprintf_filtered (stream, " => %s",
 350                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 351           lastval = TYPE_FIELD_ENUMVAL (type, i);
 352         }
 353       lastval += 1;
 354     }
 355   fprintf_filtered (stream, ")");
 356 }
 357
 358 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 359
 360 static void
 361 print_fixed_point_type (struct type *type, struct ui_file *stream)
 362 {
 363   DOUBLEST delta = ada_delta (type);
 364   DOUBLEST small = ada_fixed_to_float (type, 1);
 365
 366   if (delta < 0.0)
 367     fprintf_filtered (stream, "delta ??");
 368   else
 369     {
 370       fprintf_filtered (stream, "delta %g", (double) delta);
 371       if (delta != small)
 372         fprintf_filtered (stream, " <'small = %g>", (double) small);
 373     }
 374 }
 375
 376 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 377    recursion (indentation) level, in case the element type itself has
 378    nested structure, and SHOW is the number of levels of internal
 379    structure to show (see ada_print_type).  */
 380
 381 static void
 382 print_array_type (struct type *type, struct ui_file *stream, int show,
 383                   int level, const struct type_print_options *flags)
 384 {
 385   int bitsize;
 386   int n_indices;
 387   struct type *elt_type = NULL;
 388
 389   if (ada_is_constrained_packed_array_type (type))
 390     type = ada_coerce_to_simple_array_type (type);
 391
 392   bitsize = 0;
 393   fprintf_filtered (stream, "array (");
 394
 395   if (type == NULL)
 396     {
 397       fprintf_filtered (stream, _("<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     fprintf_filtered (stream, " %s", name);
 784
 785   if (len > 0)
 786     {
 787       fprintf_filtered (stream, " (");
 788       for (i = 0; i < len; i += 1)
 789         {
 790           if (i > 0)
 791             {
 792               fputs_filtered ("; ", stream);
 793               wrap_here ("    ");
 794             }
 795           fprintf_filtered (stream, "a%d: ", i + 1);
 796           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 797                           flags);
 798         }
 799       fprintf_filtered (stream, ")");
 800     }
 801
 802   if (TYPE_TARGET_TYPE (type) == NULL)
 803     fprintf_filtered (stream, " return <unknown return type>");
 804   else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 805     {
 806       fprintf_filtered (stream, " return ");
 807       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 808     }
 809 }
 810
 811
 812 /* Print a description of a type TYPE0.
 813    Output goes to STREAM (via stdio).
 814    If VARSTRING is a non-empty string, print as an Ada variable/field
 815        declaration.
 816    SHOW+1 is the maximum number of levels of internal type structure
 817       to show (this applies to record types, enumerated types, and
 818       array types).
 819    SHOW is the number of levels of internal type structure to show
 820       when there is a type name for the SHOWth deepest level (0th is
 821       outer level).
 822    When SHOW<0, no inner structure is shown.
 823    LEVEL indicates level of recursion (for nested definitions).  */
 824
 825 void
 826 ada_print_type (struct type *type0, const char *varstring,
 827                 struct ui_file *stream, int show, int level,
 828                 const struct type_print_options *flags)
 829 {
 830   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 831   char *type_name = decoded_type_name (type0);
 832   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 833
 834   if (type == NULL)
 835     {
 836       if (is_var_decl)
 837         fprintf_filtered (stream, "%.*s: ",
 838                           ada_name_prefix_len (varstring), varstring);
 839       fprintf_filtered (stream, "<null type?>");
 840       return;
 841     }
 842
 843   if (show > 0)
 844     type = ada_check_typedef (type);
 845
 846   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 847     fprintf_filtered (stream, "%.*s: ",
 848                       ada_name_prefix_len (varstring), varstring);
 849
 850   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 851     {
 852       fprintf_filtered (stream, "%.*s",
 853                         ada_name_prefix_len (type_name), type_name);
 854       return;
 855     }
 856
 857   if (ada_is_aligner_type (type))
 858     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 859   else if (ada_is_constrained_packed_array_type (type)
 860            && TYPE_CODE (type) != TYPE_CODE_PTR)
 861     print_array_type (type, stream, show, level, flags);
 862   else
 863     switch (TYPE_CODE (type))
 864       {
 865       default:
 866         fprintf_filtered (stream, "<");
 867         c_print_type (type, "", stream, show, level, flags);
 868         fprintf_filtered (stream, ">");
 869         break;
 870       case TYPE_CODE_PTR:
 871       case TYPE_CODE_TYPEDEF:
 872         fprintf_filtered (stream, "access ");
 873         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 874                         flags);
 875         break;
 876       case TYPE_CODE_REF:
 877         fprintf_filtered (stream, "<ref> ");
 878         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 879                         flags);
 880         break;
 881       case TYPE_CODE_ARRAY:
 882         print_array_type (type, stream, show, level, flags);
 883         break;
 884       case TYPE_CODE_BOOL:
 885         fprintf_filtered (stream, "(false, true)");
 886         break;
 887       case TYPE_CODE_INT:
 888         if (ada_is_fixed_point_type (type))
 889           print_fixed_point_type (type, stream);
 890         else
 891           {
 892             const char *name = ada_type_name (type);
 893
 894             if (!ada_is_range_type_name (name))
 895               fprintf_filtered (stream, _("<%d-byte integer>"),
 896                                 TYPE_LENGTH (type));
 897             else
 898               {
 899                 fprintf_filtered (stream, "range ");
 900                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 901               }
 902           }
 903         break;
 904       case TYPE_CODE_RANGE:
 905         if (ada_is_fixed_point_type (type))
 906           print_fixed_point_type (type, stream);
 907         else if (ada_is_modular_type (type))
 908           fprintf_filtered (stream, "mod %s",
 909                             int_string (ada_modulus (type), 10, 0, 0, 1));
 910         else
 911           {
 912             fprintf_filtered (stream, "range ");
 913             print_range (type, stream, 1 /* bounds_prefered_p */);
 914           }
 915         break;
 916       case TYPE_CODE_FLT:
 917         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 918         break;
 919       case TYPE_CODE_ENUM:
 920         if (show < 0)
 921           fprintf_filtered (stream, "(...)");
 922         else
 923           print_enum_type (type, stream);
 924         break;
 925       case TYPE_CODE_STRUCT:
 926         if (ada_is_array_descriptor_type (type))
 927           print_array_type (type, stream, show, level, flags);
 928         else if (ada_is_bogus_array_descriptor (type))
 929           fprintf_filtered (stream,
 930                             _("array (?) of ? (<mal-formed descriptor>)"));
 931         else
 932           print_record_type (type, stream, show, level, flags);
 933         break;
 934       case TYPE_CODE_UNION:
 935         print_unchecked_union_type (type, stream, show, level, flags);
 936         break;
 937       case TYPE_CODE_FUNC:
 938         print_func_type (type, stream, varstring, flags);
 939         break;
 940       }
 941 }
 942
 943 /* Implement the la_print_typedef language method for Ada.  */
 944
 945 void
 946 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 947                    struct ui_file *stream)
 948 {
 949   type = ada_check_typedef (type);
 950   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 951   fprintf_filtered (stream, "\n");
 952 }