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 (e, RETURN_MASK_ERROR)
 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         END_CATCH
 182
 183         if (!got_error)
 184           {
 185             ada_print_scalar (type, lo, stream);
 186             fprintf_filtered (stream, " .. ");
 187             ada_print_scalar (type, hi, stream);
 188           }
 189       }
 190       break;
 191     default:
 192       fprintf_filtered (stream, "%.*s",
 193                         ada_name_prefix_len (TYPE_NAME (type)),
 194                         TYPE_NAME (type));
 195       break;
 196     }
 197 }
 198
 199 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 200    set *N past the bound and its delimiter, if any.  */
 201
 202 static void
 203 print_range_bound (struct type *type, const char *bounds, int *n,
 204                    struct ui_file *stream)
 205 {
 206   LONGEST B;
 207
 208   if (ada_scan_number (bounds, *n, &B, n))
 209     {
 210       /* STABS decodes all range types which bounds are 0 .. -1 as
 211          unsigned integers (ie. the type code is TYPE_CODE_INT, not
 212          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
 213          on the unsigned flag to determine whether the bound should
 214          be printed as a signed or an unsigned value.  This causes
 215          the upper bound of the 0 .. -1 range types to be printed as
 216          a very large unsigned number instead of -1.
 217          To workaround this stabs deficiency, we replace the TYPE by NULL
 218          to indicate default output when we detect that the bound is negative,
 219          and the type is a TYPE_CODE_INT.  The bound is negative when
 220          'm' is the last character of the number scanned in BOUNDS.  */
 221       if (bounds[*n - 1] == 'm' && TYPE_CODE (type) == TYPE_CODE_INT)
 222         type = NULL;
 223       ada_print_scalar (type, B, stream);
 224       if (bounds[*n] == '_')
 225         *n += 2;
 226     }
 227   else
 228     {
 229       int bound_len;
 230       const char *bound = bounds + *n;
 231       const char *pend;
 232
 233       pend = strstr (bound, "__");
 234       if (pend == NULL)
 235         *n += bound_len = strlen (bound);
 236       else
 237         {
 238           bound_len = pend - bound;
 239           *n += bound_len + 2;
 240         }
 241       fprintf_filtered (stream, "%.*s", bound_len, bound);
 242     }
 243 }
 244
 245 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 246    the value (if found) of the bound indicated by SUFFIX ("___L" or
 247    "___U") according to the ___XD conventions.  */
 248
 249 static void
 250 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 251                            const char *suffix, struct ui_file *stream)
 252 {
 253   LONGEST B;
 254   std::string name_buf (name, name_len);
 255   name_buf += suffix;
 256
 257   if (get_int_var_value (name_buf.c_str (), B))
 258     ada_print_scalar (type, B, stream);
 259   else
 260     fprintf_filtered (stream, "?");
 261 }
 262
 263 /* Print RAW_TYPE as a range type, using any bound information
 264    following the GNAT encoding (if available).
 265
 266    If BOUNDS_PREFERED_P is nonzero, force the printing of the range
 267    using its bounds.  Otherwise, try printing the range without
 268    printing the value of the bounds, if possible (this is only
 269    considered a hint, not a guaranty).  */
 270
 271 static void
 272 print_range_type (struct type *raw_type, struct ui_file *stream,
 273                   int bounds_prefered_p)
 274 {
 275   const char *name;
 276   struct type *base_type;
 277   const char *subtype_info;
 278
 279   gdb_assert (raw_type != NULL);
 280   name = TYPE_NAME (raw_type);
 281   gdb_assert (name != NULL);
 282
 283   if (TYPE_CODE (raw_type) == TYPE_CODE_RANGE)
 284     base_type = TYPE_TARGET_TYPE (raw_type);
 285   else
 286     base_type = raw_type;
 287
 288   subtype_info = strstr (name, "___XD");
 289   if (subtype_info == NULL)
 290     print_range (raw_type, stream, bounds_prefered_p);
 291   else
 292     {
 293       int prefix_len = subtype_info - name;
 294       const char *bounds_str;
 295       int n;
 296
 297       subtype_info += 5;
 298       bounds_str = strchr (subtype_info, '_');
 299       n = 1;
 300
 301       if (*subtype_info == 'L')
 302         {
 303           print_range_bound (base_type, bounds_str, &n, stream);
 304           subtype_info += 1;
 305         }
 306       else
 307         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 308                                    stream);
 309
 310       fprintf_filtered (stream, " .. ");
 311
 312       if (*subtype_info == 'U')
 313         print_range_bound (base_type, bounds_str, &n, stream);
 314       else
 315         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 316                                    stream);
 317     }
 318 }
 319
 320 /* Print enumerated type TYPE on STREAM.  */
 321
 322 static void
 323 print_enum_type (struct type *type, struct ui_file *stream)
 324 {
 325   int len = TYPE_NFIELDS (type);
 326   int i;
 327   LONGEST lastval;
 328
 329   fprintf_filtered (stream, "(");
 330   wrap_here (" ");
 331
 332   lastval = 0;
 333   for (i = 0; i < len; i++)
 334     {
 335       QUIT;
 336       if (i)
 337         fprintf_filtered (stream, ", ");
 338       wrap_here ("    ");
 339       fputs_filtered (ada_enum_name (TYPE_FIELD_NAME (type, i)), stream);
 340       if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 341         {
 342           fprintf_filtered (stream, " => %s",
 343                             plongest (TYPE_FIELD_ENUMVAL (type, i)));
 344           lastval = TYPE_FIELD_ENUMVAL (type, i);
 345         }
 346       lastval += 1;
 347     }
 348   fprintf_filtered (stream, ")");
 349 }
 350
 351 /* Print representation of Ada fixed-point type TYPE on STREAM.  */
 352
 353 static void
 354 print_fixed_point_type (struct type *type, struct ui_file *stream)
 355 {
 356   struct value *delta = ada_delta (type);
 357   struct value *small = ada_scaling_factor (type);
 358
 359   if (delta == nullptr)
 360     fprintf_filtered (stream, "delta ??");
 361   else
 362     {
 363       std::string str;
 364       str = target_float_to_string (value_contents (delta),
 365                                     value_type (delta), "%g");
 366       fprintf_filtered (stream, "delta %s", str.c_str());
 367       if (!value_equal (delta, small))
 368         {
 369           str = target_float_to_string (value_contents (small),
 370                                         value_type (small), "%g");
 371           fprintf_filtered (stream, " <'small = %s>", str.c_str());
 372         }
 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     {
 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_filtered (stream, "<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_filtered (stream, _("<%d-byte integer>"),
 899                                 TYPE_LENGTH (type));
 900             else
 901               {
 902                 fprintf_filtered (stream, "range ");
 903                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 904               }
 905           }
 906         break;
 907       case TYPE_CODE_RANGE:
 908         if (ada_is_fixed_point_type (type))
 909           print_fixed_point_type (type, stream);
 910         else if (ada_is_modular_type (type))
 911           fprintf_filtered (stream, "mod %s",
 912                             int_string (ada_modulus (type), 10, 0, 0, 1));
 913         else
 914           {
 915             fprintf_filtered (stream, "range ");
 916             print_range (type, stream, 1 /* bounds_prefered_p */);
 917           }
 918         break;
 919       case TYPE_CODE_FLT:
 920         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 921         break;
 922       case TYPE_CODE_ENUM:
 923         if (show < 0)
 924           fprintf_filtered (stream, "(...)");
 925         else
 926           print_enum_type (type, stream);
 927         break;
 928       case TYPE_CODE_STRUCT:
 929         if (ada_is_array_descriptor_type (type))
 930           print_array_type (type, stream, show, level, flags);
 931         else if (ada_is_bogus_array_descriptor (type))
 932           fprintf_filtered (stream,
 933                             _("array (?) of ? (<mal-formed descriptor>)"));
 934         else
 935           print_record_type (type, stream, show, level, flags);
 936         break;
 937       case TYPE_CODE_UNION:
 938         print_unchecked_union_type (type, stream, show, level, flags);
 939         break;
 940       case TYPE_CODE_FUNC:
 941         print_func_type (type, stream, varstring, flags);
 942         break;
 943       }
 944 }
 945
 946 /* Implement the la_print_typedef language method for Ada.  */
 947
 948 void
 949 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 950                    struct ui_file *stream)
 951 {
 952   type = ada_check_typedef (type);
 953   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 954   fprintf_filtered (stream, "\n");
 955 }