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   int OK;
 260
 261   GROW_VECT (name_buf, name_buf_len, name_len + strlen (suffix) + 1);
 262   strncpy (name_buf, name, name_len);
 263   strcpy (name_buf + name_len, suffix);
 264
 265   B = get_int_var_value (name_buf, &OK);
 266   if (OK)
 267     ada_print_scalar (type, B, stream);
 268   else
 269     fprintf_filtered (stream, "?");
 270 }
 271
 272 /* Print RAW_TYPE as a range type, using any bound information
 273    following the GNAT encoding (if available).
 274
 275    If BOUNDS_PREFERED_P is nonzero, force the printing of the range
 276    using its bounds.  Otherwise, try printing the range without
 277    printing the value of the bounds, if possible (this is only
 278    considered a hint, not a guaranty).  */
 279
 280 static void
 281 print_range_type (struct type *raw_type, struct ui_file *stream,
 282                   int bounds_prefered_p)
 283 {
 284   const char *name;
 285   struct type *base_type;
 286   const char *subtype_info;
 287
 288   gdb_assert (raw_type != NULL);
 289   name = TYPE_NAME (raw_type);
 290   gdb_assert (name != NULL);
 291
 292   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 293     base_type = TYPE_TARGET_TYPE (raw_type);
 294   else
 295     base_type = raw_type;
 296
 297   subtype_info = strstr (name, "___XD");
 298   if (subtype_info == NULL)
 299     print_range (raw_type, stream, bounds_prefered_p);
 300   else
 301     {
 302       int prefix_len = subtype_info - name;
 303       const char *bounds_str;
 304       int n;
 305
 306       subtype_info += 5;
 307       bounds_str = strchr (subtype_info, '_');
 308       n = 1;
 309
 310       if (*subtype_info == 'L')
 311         {
 312           print_range_bound (base_type, bounds_str, &n, stream);
 313           subtype_info += 1;
 314         }
 315       else
 316         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 317                                    stream);
 318
 319       fprintf_filtered (stream, " .. ");
 320
 321       if (*subtype_info == 'U')
 322         print_range_bound (base_type, bounds_str, &n, stream);
 323       else
 324         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 325                                    stream);
 326     }
 327 }
 328
 329 /* Print enumerated type TYPE on STREAM.  */
 330
 331 static void
 332 print_enum_type (struct type *type, struct ui_file *stream)
 333 {
 334   int len = TYPE_NFIELDS (type);
 335   int i;
 336   LONGEST lastval;
 337
 338   fprintf_filtered (stream, "(");
 339   wrap_here (" ");
 340
 341   lastval = 0;
 342   for (i = 0; i < len; i++)
 343     {
 344       QUIT;
 345       if (i)
 346         fprintf_filtered (stream, ", ");
 347       wrap_here ("    ");
 348       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 349       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 350         {
 351           fprintf_filtered (stream, " => %s",
 352                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 353           lastval = TYPE_FIELD_ENUMVAL (type, i);
 354         }
 355       lastval += 1;
 356     }
 357   fprintf_filtered (stream, ")");
 358 }
 359
 360 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 361
 362 static void
 363 print_fixed_point_type (struct type *type, struct ui_file *stream)
 364 {
 365   DOUBLEST delta = ada_delta (type);
 366   DOUBLEST small = ada_fixed_to_float (type, 1);
 367
 368   if (delta < 0.0)
 369     fprintf_filtered (stream, "delta ??");
 370   else
 371     {
 372       fprintf_filtered (stream, "delta %g", (double) delta);
 373       if (delta != small)
 374         fprintf_filtered (stream, " <'small = %g>", (double) small);
 375     }
 376 }
 377
 378 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 379    recursion (indentation) level, in case the element type itself has
 380    nested structure, and SHOW is the number of levels of internal
 381    structure to show (see ada_print_type).  */
 382
 383 static void
 384 print_array_type (struct type *type, struct ui_file *stream, int show,
 385                   int level, const struct type_print_options *flags)
 386 {
 387   int bitsize;
 388   int n_indices;
 389   struct type *elt_type = NULL;
 390
 391   if (ada_is_constrained_packed_array_type (type))
 392     type = ada_coerce_to_simple_array_type (type);
 393
 394   bitsize = 0;
 395   fprintf_filtered (stream, "array (");
 396
 397   if (type == NULL)
 398     {
 399       fprintf_filtered (stream, _("<undecipherable array type>"));
 400       return;
 401     }
 402
 403   n_indices = -1;
 404   if (ada_is_simple_array_type (type))
 405     {
 406       struct type *range_desc_type;
 407       struct type *arr_type;
 408
 409       range_desc_type = ada_find_parallel_type (type, "___XA");
 410       ada_fixup_array_indexes_type (range_desc_type);
 411
 412       bitsize = 0;
 413       if (range_desc_type == NULL)
 414         {
 415           for (arr_type = type; TYPE_CODE (arr_type) == TYPE_CODE_ARRAY;
 416                arr_type = TYPE_TARGET_TYPE (arr_type))
 417             {
 418               if (arr_type != type)
 419                 fprintf_filtered (stream, ", ");
 420               print_range (TYPE_INDEX_TYPE (arr_type), stream,
 421                            0 /* bounds_prefered_p */);
 422               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 423                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 424             }
 425         }
 426       else
 427         {
 428           int k;
 429
 430           n_indices = TYPE_NFIELDS (range_desc_type);
 431           for (k = 0, arr_type = type;
 432                k < n_indices;
 433                k += 1, arr_type = TYPE_TARGET_TYPE (arr_type))
 434             {
 435               if (k > 0)
 436                 fprintf_filtered (stream, ", ");
 437               print_range_type (TYPE_FIELD_TYPE (range_desc_type, k),
 438                                 stream, 0 /* bounds_prefered_p */);
 439               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 440                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 441             }
 442         }
 443     }
 444   else
 445     {
 446       int i, i0;
 447
 448       for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 449         fprintf_filtered (stream, "%s<>", i == i0 ? "" : ", ");
 450     }
 451
 452   elt_type = ada_array_element_type (type, n_indices);
 453   fprintf_filtered (stream, ") of ");
 454   wrap_here ("");
 455   ada_print_type (elt_type, "", stream, show == 0 ? 0 : show - 1, level + 1,
 456                   flags);
 457   /* Arrays with variable-length elements are never bit-packed in practice but
 458      compilers have to describe their stride so that we can properly fetch
 459      individual elements.  Do not say the array is packed in this case.  */
 460   if (bitsize > 0 && !is_dynamic_type (elt_type))
 461     fprintf_filtered (stream, " <packed: %d-bit elements>", bitsize);
 462 }
 463
 464 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 465    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 466    values.  Return non-zero if the field is an encoding of
 467    discriminant values, as in a standard variant record, and 0 if the
 468    field is not so encoded (as happens with single-component variants
 469    in types annotated with pragma Unchecked_Variant).  */
 470
 471 static int
 472 print_choices (struct type *type, int field_num, struct ui_file *stream,
 473                struct type *val_type)
 474 {
 475   int have_output;
 476   int p;
 477   const char *name = TYPE_FIELD_NAME (type, field_num);
 478
 479   have_output = 0;
 480
 481   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 482   if (name[0] == 'V')
 483     {
 484       if (!ada_scan_number (name, 1, NULL, &p))
 485         goto Huh;
 486     }
 487   else
 488     p = 0;
 489
 490   while (1)
 491     {
 492       switch (name[p])
 493         {
 494         default:
 495           goto Huh;
 496         case '_':
 497         case '\0':
 498           fprintf_filtered (stream, " =>");
 499           return 1;
 500         case 'S':
 501         case 'R':
 502         case 'O':
 503           if (have_output)
 504             fprintf_filtered (stream, " | ");
 505           have_output = 1;
 506           break;
 507         }
 508
 509       switch (name[p])
 510         {
 511         case 'S':
 512           {
 513             LONGEST W;
 514
 515             if (!ada_scan_number (name, p + 1, &W, &p))
 516               goto Huh;
 517             ada_print_scalar (val_type, W, stream);
 518             break;
 519           }
 520         case 'R':
 521           {
 522             LONGEST L, U;
 523
 524             if (!ada_scan_number (name, p + 1, &L, &p)
 525                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 526               goto Huh;
 527             ada_print_scalar (val_type, L, stream);
 528             fprintf_filtered (stream, " .. ");
 529             ada_print_scalar (val_type, U, stream);
 530             break;
 531           }
 532         case 'O':
 533           fprintf_filtered (stream, "others");
 534           p += 1;
 535           break;
 536         }
 537     }
 538
 539 Huh:
 540   fprintf_filtered (stream, "?? =>");
 541   return 0;
 542 }
 543
 544 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 545    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 546    LEVEL is the recursion (indentation) level, in case any of the fields
 547    themselves have nested structure, and SHOW is the number of levels of
 548    internal structure to show (see ada_print_type).  For this purpose,
 549    fields nested in a variant part are taken to be at the same level as
 550    the fields immediately outside the variant part.  */
 551
 552 static void
 553 print_variant_clauses (struct type *type, int field_num,
 554                        struct type *outer_type, struct ui_file *stream,
 555                        int show, int level,
 556                        const struct type_print_options *flags)
 557 {
 558   int i;
 559   struct type *var_type, *par_type;
 560   struct type *discr_type;
 561
 562   var_type = TYPE_FIELD_TYPE (type, field_num);
 563   discr_type = ada_variant_discrim_type (var_type, outer_type);
 564
 565   if (TYPE_CODE (var_type) == TYPE_CODE_PTR)
 566     {
 567       var_type = TYPE_TARGET_TYPE (var_type);
 568       if (var_type == NULL || TYPE_CODE (var_type) != TYPE_CODE_UNION)
 569         return;
 570     }
 571
 572   par_type = ada_find_parallel_type (var_type, "___XVU");
 573   if (par_type != NULL)
 574     var_type = par_type;
 575
 576   for (i = 0; i < TYPE_NFIELDS (var_type); i += 1)
 577     {
 578       fprintf_filtered (stream, "\n%*swhen ", level + 4, "");
 579       if (print_choices (var_type, i, stream, discr_type))
 580         {
 581           if (print_record_field_types (TYPE_FIELD_TYPE (var_type, i),
 582                                         outer_type, stream, show, level + 4,
 583                                         flags)
 584               <= 0)
 585             fprintf_filtered (stream, " null;");
 586         }
 587       else
 588         print_selected_record_field_types (var_type, outer_type, i, i,
 589                                            stream, show, level + 4, flags);
 590     }
 591 }
 592
 593 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 594    discriminants are contained in OUTER_TYPE, print a description of it
 595    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 596    the fields themselves have nested structure, and SHOW is the number of
 597    levels of internal structure to show (see ada_print_type).  For this
 598    purpose, fields nested in a variant part are taken to be at the same
 599    level as the fields immediately outside the variant part.  */
 600
 601 static void
 602 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 603                     struct ui_file *stream, int show, int level,
 604                     const struct type_print_options *flags)
 605 {
 606   fprintf_filtered (stream, "\n%*scase %s is", level + 4, "",
 607                     ada_variant_discrim_name
 608                     (TYPE_FIELD_TYPE (type, field_num)));
 609   print_variant_clauses (type, field_num, outer_type, stream, show,
 610                          level + 4, flags);
 611   fprintf_filtered (stream, "\n%*send case;", level + 4, "");
 612 }
 613
 614 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 615    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 616    LEVEL is the recursion (indentation) level, in case any of the
 617    fields themselves have nested structure, and SHOW is the number of
 618    levels of internal structure to show (see ada_print_type).  Does
 619    not print parent type information of TYPE.  Returns 0 if no fields
 620    printed, -1 for an incomplete type, else > 0.  Prints each field
 621    beginning on a new line, but does not put a new line at end.  */
 622
 623 static int
 624 print_selected_record_field_types (struct type *type, struct type *outer_type,
 625                                    int fld0, int fld1,
 626                                    struct ui_file *stream, int show, int level,
 627                                    const struct type_print_options *flags)
 628 {
 629   int i, flds;
 630
 631   flds = 0;
 632
 633   if (fld0 > fld1 && TYPE_STUB (type))
 634     return -1;
 635
 636   for (i = fld0; i <= fld1; i += 1)
 637     {
 638       QUIT;
 639
 640       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 641         ;
 642       else if (ada_is_wrapper_field (type, i))
 643         flds += print_record_field_types (TYPE_FIELD_TYPE (type, i), type,
 644                                           stream, show, level, flags);
 645       else if (ada_is_variant_part (type, i))
 646         {
 647           print_variant_part (type, i, outer_type, stream, show, level, flags);
 648           flds = 1;
 649         }
 650       else
 651         {
 652           flds += 1;
 653           fprintf_filtered (stream, "\n%*s", level + 4, "");
 654           ada_print_type (TYPE_FIELD_TYPE (type, i),
 655                           TYPE_FIELD_NAME (type, i),
 656                           stream, show - 1, level + 4, flags);
 657           fprintf_filtered (stream, ";");
 658         }
 659     }
 660
 661   return flds;
 662 }
 663
 664 /* Print a description on STREAM of all fields of record or union type
 665    TYPE, as for print_selected_record_field_types, above.  */
 666
 667 static int
 668 print_record_field_types (struct type *type, struct type *outer_type,
 669                           struct ui_file *stream, int show, int level,
 670                           const struct type_print_options *flags)
 671 {
 672   return print_selected_record_field_types (type, outer_type,
 673                                             0, TYPE_NFIELDS (type) - 1,
 674                                             stream, show, level, flags);
 675 }
 676
 677
 678 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 679    level, in case the element type itself has nested structure, and SHOW is
 680    the number of levels of internal structure to show (see ada_print_type).  */
 681
 682 static void
 683 print_record_type (struct type *type0, struct ui_file *stream, int show,
 684                    int level, const struct type_print_options *flags)
 685 {
 686   struct type *parent_type;
 687   struct type *type;
 688
 689   type = ada_find_parallel_type (type0, "___XVE");
 690   if (type == NULL)
 691     type = type0;
 692
 693   parent_type = ada_parent_type (type);
 694   if (ada_type_name (parent_type) != NULL)
 695     {
 696       const char *parent_name = decoded_type_name (parent_type);
 697
 698       /* If we fail to decode the parent type name, then use the parent
 699          type name as is.  Not pretty, but should never happen except
 700          when the debugging info is incomplete or incorrect.  This
 701          prevents a crash trying to print a NULL pointer.  */
 702       if (parent_name == NULL)
 703         parent_name = ada_type_name (parent_type);
 704       fprintf_filtered (stream, "new %s with record", parent_name);
 705     }
 706   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 707     fprintf_filtered (stream, "tagged record");
 708   else
 709     fprintf_filtered (stream, "record");
 710
 711   if (show < 0)
 712     fprintf_filtered (stream, " ... end record");
 713   else
 714     {
 715       int flds;
 716
 717       flds = 0;
 718       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 719         flds += print_record_field_types (parent_type, parent_type,
 720                                           stream, show, level, flags);
 721       flds += print_record_field_types (type, type, stream, show, level,
 722                                         flags);
 723
 724       if (flds > 0)
 725         fprintf_filtered (stream, "\n%*send record", level, "");
 726       else if (flds < 0)
 727         fprintf_filtered (stream, _(" <incomplete type> end record"));
 728       else
 729         fprintf_filtered (stream, " null; end record");
 730     }
 731 }
 732
 733 /* Print the unchecked union type TYPE in something resembling Ada
 734    format on STREAM.  LEVEL is the recursion (indentation) level
 735    in case the element type itself has nested structure, and SHOW is the
 736    number of levels of internal structure to show (see ada_print_type).  */
 737 static void
 738 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 739                             int show, int level,
 740                             const struct type_print_options *flags)
 741 {
 742   if (show < 0)
 743     fprintf_filtered (stream, "record (?) is ... end record");
 744   else if (TYPE_NFIELDS (type) == 0)
 745     fprintf_filtered (stream, "record (?) is null; end record");
 746   else
 747     {
 748       int i;
 749
 750       fprintf_filtered (stream, "record (?) is\n%*scase ? is", level + 4, "");
 751
 752       for (i = 0; i < TYPE_NFIELDS (type); i += 1)
 753         {
 754           fprintf_filtered (stream, "\n%*swhen ? =>\n%*s", level + 8, "",
 755                             level + 12, "");
 756           ada_print_type (TYPE_FIELD_TYPE (type, i),
 757                           TYPE_FIELD_NAME (type, i),
 758                           stream, show - 1, level + 12, flags);
 759           fprintf_filtered (stream, ";");
 760         }
 761
 762       fprintf_filtered (stream, "\n%*send case;\n%*send record",
 763                         level + 4, "", level, "");
 764     }
 765 }
 766
 767
 768
 769 /* Print function or procedure type TYPE on STREAM.  Make it a header
 770    for function or procedure NAME if NAME is not null.  */
 771
 772 static void
 773 print_func_type (struct type *type, struct ui_file *stream, const char *name,
 774                  const struct type_print_options *flags)
 775 {
 776   int i, len = TYPE_NFIELDS (type);
 777
 778   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID)
 779     fprintf_filtered (stream, "procedure");
 780   else
 781     fprintf_filtered (stream, "function");
 782
 783   if (name != NULL && name[0] != '\0')
 784     fprintf_filtered (stream, " %s", name);
 785
 786   if (len > 0)
 787     {
 788       fprintf_filtered (stream, " (");
 789       for (i = 0; i < len; i += 1)
 790         {
 791           if (i > 0)
 792             {
 793               fputs_filtered ("; ", stream);
 794               wrap_here ("    ");
 795             }
 796           fprintf_filtered (stream, "a%d: ", i + 1);
 797           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 798                           flags);
 799         }
 800       fprintf_filtered (stream, ")");
 801     }
 802
 803   if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 804     {
 805       fprintf_filtered (stream, " return ");
 806       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 807     }
 808 }
 809
 810
 811 /* Print a description of a type TYPE0.
 812    Output goes to STREAM (via stdio).
 813    If VARSTRING is a non-empty string, print as an Ada variable/field
 814        declaration.
 815    SHOW+1 is the maximum number of levels of internal type structure
 816       to show (this applies to record types, enumerated types, and
 817       array types).
 818    SHOW is the number of levels of internal type structure to show
 819       when there is a type name for the SHOWth deepest level (0th is
 820       outer level).
 821    When SHOW<0, no inner structure is shown.
 822    LEVEL indicates level of recursion (for nested definitions).  */
 823
 824 void
 825 ada_print_type (struct type *type0, const char *varstring,
 826                 struct ui_file *stream, int show, int level,
 827                 const struct type_print_options *flags)
 828 {
 829   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 830   char *type_name = decoded_type_name (type0);
 831   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 832
 833   if (type == NULL)
 834     {
 835       if (is_var_decl)
 836         fprintf_filtered (stream, "%.*s: ",
 837                           ada_name_prefix_len (varstring), varstring);
 838       fprintf_filtered (stream, "<null type?>");
 839       return;
 840     }
 841
 842   if (show > 0)
 843     type = ada_check_typedef (type);
 844
 845   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 846     fprintf_filtered (stream, "%.*s: ",
 847                       ada_name_prefix_len (varstring), varstring);
 848
 849   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 850     {
 851       fprintf_filtered (stream, "%.*s",
 852                         ada_name_prefix_len (type_name), type_name);
 853       return;
 854     }
 855
 856   if (ada_is_aligner_type (type))
 857     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 858   else if (ada_is_constrained_packed_array_type (type)
 859            && TYPE_CODE (type) != TYPE_CODE_PTR)
 860     print_array_type (type, stream, show, level, flags);
 861   else
 862     switch (TYPE_CODE (type))
 863       {
 864       default:
 865         fprintf_filtered (stream, "<");
 866         c_print_type (type, "", stream, show, level, flags);
 867         fprintf_filtered (stream, ">");
 868         break;
 869       case TYPE_CODE_PTR:
 870       case TYPE_CODE_TYPEDEF:
 871         fprintf_filtered (stream, "access ");
 872         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 873                         flags);
 874         break;
 875       case TYPE_CODE_REF:
 876         fprintf_filtered (stream, "<ref> ");
 877         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 878                         flags);
 879         break;
 880       case TYPE_CODE_ARRAY:
 881         print_array_type (type, stream, show, level, flags);
 882         break;
 883       case TYPE_CODE_BOOL:
 884         fprintf_filtered (stream, "(false, true)");
 885         break;
 886       case TYPE_CODE_INT:
 887         if (ada_is_fixed_point_type (type))
 888           print_fixed_point_type (type, stream);
 889         else
 890           {
 891             const char *name = ada_type_name (type);
 892
 893             if (!ada_is_range_type_name (name))
 894               fprintf_filtered (stream, _("<%d-byte integer>"),
 895                                 TYPE_LENGTH (type));
 896             else
 897               {
 898                 fprintf_filtered (stream, "range ");
 899                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 900               }
 901           }
 902         break;
 903       case TYPE_CODE_RANGE:
 904         if (ada_is_fixed_point_type (type))
 905           print_fixed_point_type (type, stream);
 906         else if (ada_is_modular_type (type))
 907           fprintf_filtered (stream, "mod %s",
 908                             int_string (ada_modulus (type), 10, 0, 0, 1));
 909         else
 910           {
 911             fprintf_filtered (stream, "range ");
 912             print_range (type, stream, 1 /* bounds_prefered_p */);
 913           }
 914         break;
 915       case TYPE_CODE_FLT:
 916         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 917         break;
 918       case TYPE_CODE_ENUM:
 919         if (show < 0)
 920           fprintf_filtered (stream, "(...)");
 921         else
 922           print_enum_type (type, stream);
 923         break;
 924       case TYPE_CODE_STRUCT:
 925         if (ada_is_array_descriptor_type (type))
 926           print_array_type (type, stream, show, level, flags);
 927         else if (ada_is_bogus_array_descriptor (type))
 928           fprintf_filtered (stream,
 929                             _("array (?) of ? (<mal-formed descriptor>)"));
 930         else
 931           print_record_type (type, stream, show, level, flags);
 932         break;
 933       case TYPE_CODE_UNION:
 934         print_unchecked_union_type (type, stream, show, level, flags);
 935         break;
 936       case TYPE_CODE_FUNC:
 937         print_func_type (type, stream, varstring, flags);
 938         break;
 939       }
 940 }
 941
 942 /* Implement the la_print_typedef language method for Ada.  */
 943
 944 void
 945 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 946                    struct ui_file *stream)
 947 {
 948   type = ada_check_typedef (type);
 949   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 950   fprintf_filtered (stream, "\n");
 951 }