gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986-2023 Free Software Foundation, Inc.
   3
   4    This file is part of GDB.
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 3 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include "defs.h"
  20 #include "bfd.h"                /* Binary File Description */
  21 #include "gdbtypes.h"
  22 #include "value.h"
  23 #include "c-lang.h"
  24 #include "cli/cli-style.h"
  25 #include "typeprint.h"
  26 #include "target-float.h"
  27 #include "ada-lang.h"
  28 #include <ctype.h>
  29
  30 static int print_selected_record_field_types (struct type *, struct type *,
  31                                               int, int,
  32                                               struct ui_file *, int, int,
  33                                               const struct type_print_options *);
  34
  35 static int print_record_field_types (struct type *, struct type *,
  36                                      struct ui_file *, int, int,
  37                                      const struct type_print_options *);
  38 \f
  39
  40
  41 static char *name_buffer;
  42 static int name_buffer_len;
  43
  44 /* The (decoded) Ada name of TYPE.  This value persists until the
  45    next call.  */
  46
  47 static char *
  48 decoded_type_name (struct type *type)
  49 {
  50   if (ada_type_name (type) == NULL)
  51     return NULL;
  52   else
  53     {
  54       const char *raw_name = ada_type_name (type);
  55       char *s, *q;
  56
  57       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  58         {
  59           name_buffer_len = 16 + 2 * strlen (raw_name);
  60           name_buffer = (char *) xrealloc (name_buffer, name_buffer_len);
  61         }
  62       strcpy (name_buffer, raw_name);
  63
  64       s = (char *) strstr (name_buffer, "___");
  65       if (s != NULL)
  66         *s = '\0';
  67
  68       s = name_buffer + strlen (name_buffer) - 1;
  69       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
  70         s -= 1;
  71
  72       if (s == name_buffer)
  73         return name_buffer;
  74
  75       if (!islower (s[1]))
  76         return NULL;
  77
  78       for (s = q = name_buffer; *s != '\0'; q += 1)
  79         {
  80           if (s[0] == '_' && s[1] == '_')
  81             {
  82               *q = '.';
  83               s += 2;
  84             }
  85           else
  86             {
  87               *q = *s;
  88               s += 1;
  89             }
  90         }
  91       *q = '\0';
  92       return name_buffer;
  93     }
  94 }
  95
  96 /* Return nonzero if TYPE is a subrange type, and its bounds
  97    are identical to the bounds of its subtype.  */
  98
  99 static int
 100 type_is_full_subrange_of_target_type (struct type *type)
 101 {
 102   struct type *subtype;
 103
 104   if (type->code () != TYPE_CODE_RANGE)
 105     return 0;
 106
 107   subtype = type->target_type ();
 108   if (subtype == NULL)
 109     return 0;
 110
 111   if (is_dynamic_type (type))
 112     return 0;
 113
 114   if (ada_discrete_type_low_bound (type)
 115       != ada_discrete_type_low_bound (subtype))
 116     return 0;
 117
 118   if (ada_discrete_type_high_bound (type)
 119       != ada_discrete_type_high_bound (subtype))
 120     return 0;
 121
 122   return 1;
 123 }
 124
 125 /* Print TYPE on STREAM, preferably as a range if BOUNDS_PREFERED_P
 126    is nonzero.  */
 127
 128 static void
 129 print_range (struct type *type, struct ui_file *stream,
 130              int bounds_prefered_p)
 131 {
 132   if (!bounds_prefered_p)
 133     {
 134       /* Try stripping all TYPE_CODE_RANGE layers whose bounds
 135          are identical to the bounds of their subtype.  When
 136          the bounds of both types match, it can allow us to
 137          print a range using the name of its base type, which
 138          is easier to read.  For instance, we would print...
 139
 140              array (character) of ...
 141
 142          ... instead of...
 143
 144              array ('["00"]' .. '["ff"]') of ...  */
 145       while (type_is_full_subrange_of_target_type (type))
 146         type = type->target_type ();
 147     }
 148
 149   switch (type->code ())
 150     {
 151     case TYPE_CODE_RANGE:
 152     case TYPE_CODE_ENUM:
 153       {
 154         LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 155         int got_error = 0;
 156
 157         try
 158           {
 159             lo = ada_discrete_type_low_bound (type);
 160             hi = ada_discrete_type_high_bound (type);
 161           }
 162         catch (const gdb_exception_error &e)
 163           {
 164             /* This can happen when the range is dynamic.  Sometimes,
 165                resolving dynamic property values requires us to have
 166                access to an actual object, which is not available
 167                when the user is using the "ptype" command on a type.
 168                Print the range as an unbounded range.  */
 169             gdb_printf (stream, "<>");
 170             got_error = 1;
 171           }
 172
 173         if (!got_error)
 174           {
 175             ada_print_scalar (type, lo, stream);
 176             gdb_printf (stream, " .. ");
 177             ada_print_scalar (type, hi, stream);
 178           }
 179       }
 180       break;
 181     default:
 182       gdb_printf (stream, "%.*s",
 183                   ada_name_prefix_len (type->name ()),
 184                   type->name ());
 185       break;
 186     }
 187 }
 188
 189 /* Print the number or discriminant bound at BOUNDS+*N on STREAM, and
 190    set *N past the bound and its delimiter, if any.  */
 191
 192 static void
 193 print_range_bound (struct type *type, const char *bounds, int *n,
 194                    struct ui_file *stream)
 195 {
 196   LONGEST B;
 197
 198   if (ada_scan_number (bounds, *n, &B, n))
 199     {
 200       /* STABS decodes all range types which bounds are 0 .. -1 as
 201          unsigned integers (ie. the type code is TYPE_CODE_INT, not
 202          TYPE_CODE_RANGE).  Unfortunately, ada_print_scalar() relies
 203          on the unsigned flag to determine whether the bound should
 204          be printed as a signed or an unsigned value.  This causes
 205          the upper bound of the 0 .. -1 range types to be printed as
 206          a very large unsigned number instead of -1.
 207          To workaround this stabs deficiency, we replace the TYPE by NULL
 208          to indicate default output when we detect that the bound is negative,
 209          and the type is a TYPE_CODE_INT.  The bound is negative when
 210          'm' is the last character of the number scanned in BOUNDS.  */
 211       if (bounds[*n - 1] == 'm' && type->code () == TYPE_CODE_INT)
 212         type = NULL;
 213       ada_print_scalar (type, B, stream);
 214       if (bounds[*n] == '_')
 215         *n += 2;
 216     }
 217   else
 218     {
 219       int bound_len;
 220       const char *bound = bounds + *n;
 221       const char *pend;
 222
 223       pend = strstr (bound, "__");
 224       if (pend == NULL)
 225         *n += bound_len = strlen (bound);
 226       else
 227         {
 228           bound_len = pend - bound;
 229           *n += bound_len + 2;
 230         }
 231       gdb_printf (stream, "%.*s", bound_len, bound);
 232     }
 233 }
 234
 235 /* Assuming NAME[0 .. NAME_LEN-1] is the name of a range type, print
 236    the value (if found) of the bound indicated by SUFFIX ("___L" or
 237    "___U") according to the ___XD conventions.  */
 238
 239 static void
 240 print_dynamic_range_bound (struct type *type, const char *name, int name_len,
 241                            const char *suffix, struct ui_file *stream)
 242 {
 243   LONGEST B;
 244   std::string name_buf (name, name_len);
 245   name_buf += suffix;
 246
 247   if (get_int_var_value (name_buf.c_str (), B))
 248     ada_print_scalar (type, B, stream);
 249   else
 250     gdb_printf (stream, "?");
 251 }
 252
 253 /* Print RAW_TYPE as a range type, using any bound information
 254    following the GNAT encoding (if available).
 255
 256    If BOUNDS_PREFERED_P is nonzero, force the printing of the range
 257    using its bounds.  Otherwise, try printing the range without
 258    printing the value of the bounds, if possible (this is only
 259    considered a hint, not a guaranty).  */
 260
 261 static void
 262 print_range_type (struct type *raw_type, struct ui_file *stream,
 263                   int bounds_prefered_p)
 264 {
 265   const char *name;
 266   struct type *base_type;
 267   const char *subtype_info;
 268
 269   gdb_assert (raw_type != NULL);
 270   name = raw_type->name ();
 271   gdb_assert (name != NULL);
 272
 273   if (raw_type->code () == TYPE_CODE_RANGE)
 274     base_type = raw_type->target_type ();
 275   else
 276     base_type = raw_type;
 277
 278   subtype_info = strstr (name, "___XD");
 279   if (subtype_info == NULL)
 280     print_range (raw_type, stream, bounds_prefered_p);
 281   else
 282     {
 283       int prefix_len = subtype_info - name;
 284       const char *bounds_str;
 285       int n;
 286
 287       subtype_info += 5;
 288       bounds_str = strchr (subtype_info, '_');
 289       n = 1;
 290
 291       if (*subtype_info == 'L')
 292         {
 293           print_range_bound (base_type, bounds_str, &n, stream);
 294           subtype_info += 1;
 295         }
 296       else
 297         print_dynamic_range_bound (base_type, name, prefix_len, "___L",
 298                                    stream);
 299
 300       gdb_printf (stream, " .. ");
 301
 302       if (*subtype_info == 'U')
 303         print_range_bound (base_type, bounds_str, &n, stream);
 304       else
 305         print_dynamic_range_bound (base_type, name, prefix_len, "___U",
 306                                    stream);
 307     }
 308 }
 309
 310 /* Print enumerated type TYPE on STREAM.  */
 311
 312 static void
 313 print_enum_type (struct type *type, struct ui_file *stream)
 314 {
 315   int len = type->num_fields ();
 316   int i;
 317   LONGEST lastval;
 318
 319   gdb_printf (stream, "(");
 320   stream->wrap_here (1);
 321
 322   lastval = 0;
 323   for (i = 0; i < len; i++)
 324     {
 325       QUIT;
 326       if (i)
 327         gdb_printf (stream, ", ");
 328       stream->wrap_here (4);
 329       fputs_styled (ada_enum_name (type->field (i).name ()),
 330                     variable_name_style.style (), stream);
 331       if (lastval != type->field (i).loc_enumval ())
 332         {
 333           gdb_printf (stream, " => %s",
 334                       plongest (type->field (i).loc_enumval ()));
 335           lastval = type->field (i).loc_enumval ();
 336         }
 337       lastval += 1;
 338     }
 339   gdb_printf (stream, ")");
 340 }
 341
 342 /* Print simple (constrained) array type TYPE on STREAM.  LEVEL is the
 343    recursion (indentation) level, in case the element type itself has
 344    nested structure, and SHOW is the number of levels of internal
 345    structure to show (see ada_print_type).  */
 346
 347 static void
 348 print_array_type (struct type *type, struct ui_file *stream, int show,
 349                   int level, const struct type_print_options *flags)
 350 {
 351   int bitsize;
 352   int n_indices;
 353   struct type *elt_type = NULL;
 354
 355   if (ada_is_constrained_packed_array_type (type))
 356     type = ada_coerce_to_simple_array_type (type);
 357
 358   bitsize = 0;
 359   gdb_printf (stream, "array (");
 360
 361   if (type == NULL)
 362     {
 363       fprintf_styled (stream, metadata_style.style (),
 364                       _("<undecipherable array type>"));
 365       return;
 366     }
 367
 368   n_indices = -1;
 369   if (ada_is_simple_array_type (type))
 370     {
 371       struct type *range_desc_type;
 372       struct type *arr_type;
 373
 374       range_desc_type = ada_find_parallel_type (type, "___XA");
 375       ada_fixup_array_indexes_type (range_desc_type);
 376
 377       bitsize = 0;
 378       if (range_desc_type == NULL)
 379         {
 380           for (arr_type = type; arr_type->code () == TYPE_CODE_ARRAY; )
 381             {
 382               if (arr_type != type)
 383                 gdb_printf (stream, ", ");
 384               print_range (arr_type->index_type (), stream,
 385                            0 /* bounds_prefered_p */);
 386               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 387                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 388               /* A multi-dimensional array is represented using a
 389                  sequence of array types.  If one of these types has a
 390                  name, then it is not another dimension of the outer
 391                  array, but rather the element type of the outermost
 392                  array.  */
 393               arr_type = arr_type->target_type ();
 394               if (arr_type->name () != nullptr)
 395                 break;
 396             }
 397         }
 398       else
 399         {
 400           int k;
 401
 402           n_indices = range_desc_type->num_fields ();
 403           for (k = 0, arr_type = type;
 404                k < n_indices;
 405                k += 1, arr_type = arr_type->target_type ())
 406             {
 407               if (k > 0)
 408                 gdb_printf (stream, ", ");
 409               print_range_type (range_desc_type->field (k).type (),
 410                                 stream, 0 /* bounds_prefered_p */);
 411               if (TYPE_FIELD_BITSIZE (arr_type, 0) > 0)
 412                 bitsize = TYPE_FIELD_BITSIZE (arr_type, 0);
 413             }
 414         }
 415     }
 416   else
 417     {
 418       int i, i0;
 419
 420       for (i = i0 = ada_array_arity (type); i > 0; i -= 1)
 421         gdb_printf (stream, "%s<>", i == i0 ? "" : ", ");
 422     }
 423
 424   elt_type = ada_array_element_type (type, n_indices);
 425   gdb_printf (stream, ") of ");
 426   stream->wrap_here (0);
 427   ada_print_type (elt_type, "", stream, show == 0 ? 0 : show - 1, level + 1,
 428                   flags);
 429   /* Arrays with variable-length elements are never bit-packed in practice but
 430      compilers have to describe their stride so that we can properly fetch
 431      individual elements.  Do not say the array is packed in this case.  */
 432   if (bitsize > 0 && !is_dynamic_type (elt_type))
 433     gdb_printf (stream, " <packed: %d-bit elements>", bitsize);
 434 }
 435
 436 /* Print the choices encoded by field FIELD_NUM of variant-part TYPE on
 437    STREAM, assuming that VAL_TYPE (if non-NULL) is the type of the
 438    values.  Return non-zero if the field is an encoding of
 439    discriminant values, as in a standard variant record, and 0 if the
 440    field is not so encoded (as happens with single-component variants
 441    in types annotated with pragma Unchecked_Union).  */
 442
 443 static int
 444 print_choices (struct type *type, int field_num, struct ui_file *stream,
 445                struct type *val_type)
 446 {
 447   int have_output;
 448   int p;
 449   const char *name = type->field (field_num).name ();
 450
 451   have_output = 0;
 452
 453   /* Skip over leading 'V': NOTE soon to be obsolete.  */
 454   if (name[0] == 'V')
 455     {
 456       if (!ada_scan_number (name, 1, NULL, &p))
 457         goto Huh;
 458     }
 459   else
 460     p = 0;
 461
 462   while (1)
 463     {
 464       switch (name[p])
 465         {
 466         default:
 467           goto Huh;
 468         case '_':
 469         case '\0':
 470           gdb_printf (stream, " =>");
 471           return 1;
 472         case 'S':
 473         case 'R':
 474         case 'O':
 475           if (have_output)
 476             gdb_printf (stream, " | ");
 477           have_output = 1;
 478           break;
 479         }
 480
 481       switch (name[p])
 482         {
 483         case 'S':
 484           {
 485             LONGEST W;
 486
 487             if (!ada_scan_number (name, p + 1, &W, &p))
 488               goto Huh;
 489             ada_print_scalar (val_type, W, stream);
 490             break;
 491           }
 492         case 'R':
 493           {
 494             LONGEST L, U;
 495
 496             if (!ada_scan_number (name, p + 1, &L, &p)
 497                 || name[p] != 'T' || !ada_scan_number (name, p + 1, &U, &p))
 498               goto Huh;
 499             ada_print_scalar (val_type, L, stream);
 500             gdb_printf (stream, " .. ");
 501             ada_print_scalar (val_type, U, stream);
 502             break;
 503           }
 504         case 'O':
 505           gdb_printf (stream, "others");
 506           p += 1;
 507           break;
 508         }
 509     }
 510
 511 Huh:
 512   gdb_printf (stream, "? =>");
 513   return 0;
 514 }
 515
 516 /* A helper for print_variant_clauses that prints the members of
 517    VAR_TYPE.  DISCR_TYPE is the type of the discriminant (or nullptr
 518    if not available).  The discriminant is contained in OUTER_TYPE.
 519    STREAM, LEVEL, SHOW, and FLAGS are the same as for
 520    ada_print_type.  */
 521
 522 static void
 523 print_variant_clauses (struct type *var_type, struct type *discr_type,
 524                        struct type *outer_type, struct ui_file *stream,
 525                        int show, int level,
 526                        const struct type_print_options *flags)
 527 {
 528   for (int i = 0; i < var_type->num_fields (); i += 1)
 529     {
 530       gdb_printf (stream, "\n%*swhen ", level, "");
 531       if (print_choices (var_type, i, stream, discr_type))
 532         {
 533           if (print_record_field_types (var_type->field (i).type (),
 534                                         outer_type, stream, show, level,
 535                                         flags)
 536               <= 0)
 537             gdb_printf (stream, " null;");
 538         }
 539       else
 540         print_selected_record_field_types (var_type, outer_type, i, i,
 541                                            stream, show, level, flags);
 542     }
 543 }
 544
 545 /* Assuming that field FIELD_NUM of TYPE represents variants whose
 546    discriminant is contained in OUTER_TYPE, print its components on STREAM.
 547    LEVEL is the recursion (indentation) level, in case any of the fields
 548    themselves have nested structure, and SHOW is the number of levels of
 549    internal structure to show (see ada_print_type).  For this purpose,
 550    fields nested in a variant part are taken to be at the same level as
 551    the fields immediately outside the variant part.  */
 552
 553 static void
 554 print_variant_clauses (struct type *type, int field_num,
 555                        struct type *outer_type, struct ui_file *stream,
 556                        int show, int level,
 557                        const struct type_print_options *flags)
 558 {
 559   struct type *var_type, *par_type;
 560   struct type *discr_type;
 561
 562   var_type = type->field (field_num).type ();
 563   discr_type = ada_variant_discrim_type (var_type, outer_type);
 564
 565   if (var_type->code () == TYPE_CODE_PTR)
 566     {
 567       var_type = var_type->target_type ();
 568       if (var_type == NULL || var_type->code () != 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   print_variant_clauses (var_type, discr_type, outer_type, stream, show,
 577                          level + 4, flags);
 578 }
 579
 580 /* Assuming that field FIELD_NUM of TYPE is a variant part whose
 581    discriminants are contained in OUTER_TYPE, print a description of it
 582    on STREAM.  LEVEL is the recursion (indentation) level, in case any of
 583    the fields themselves have nested structure, and SHOW is the number of
 584    levels of internal structure to show (see ada_print_type).  For this
 585    purpose, fields nested in a variant part are taken to be at the same
 586    level as the fields immediately outside the variant part.  */
 587
 588 static void
 589 print_variant_part (struct type *type, int field_num, struct type *outer_type,
 590                     struct ui_file *stream, int show, int level,
 591                     const struct type_print_options *flags)
 592 {
 593   const char *variant
 594     = ada_variant_discrim_name (type->field (field_num).type ());
 595   if (*variant == '\0')
 596     variant = "?";
 597
 598   gdb_printf (stream, "\n%*scase %s is", level + 4, "", variant);
 599   print_variant_clauses (type, field_num, outer_type, stream, show,
 600                          level + 4, flags);
 601   gdb_printf (stream, "\n%*send case;", level + 4, "");
 602 }
 603
 604 /* Print a description on STREAM of the fields FLD0 through FLD1 in
 605    record or union type TYPE, whose discriminants are in OUTER_TYPE.
 606    LEVEL is the recursion (indentation) level, in case any of the
 607    fields themselves have nested structure, and SHOW is the number of
 608    levels of internal structure to show (see ada_print_type).  Does
 609    not print parent type information of TYPE.  Returns 0 if no fields
 610    printed, -1 for an incomplete type, else > 0.  Prints each field
 611    beginning on a new line, but does not put a new line at end.  */
 612
 613 static int
 614 print_selected_record_field_types (struct type *type, struct type *outer_type,
 615                                    int fld0, int fld1,
 616                                    struct ui_file *stream, int show, int level,
 617                                    const struct type_print_options *flags)
 618 {
 619   int i, flds;
 620
 621   flds = 0;
 622
 623   if (fld0 > fld1 && type->is_stub ())
 624     return -1;
 625
 626   for (i = fld0; i <= fld1; i += 1)
 627     {
 628       QUIT;
 629
 630       if (ada_is_parent_field (type, i) || ada_is_ignored_field (type, i))
 631         ;
 632       else if (ada_is_wrapper_field (type, i))
 633         flds += print_record_field_types (type->field (i).type (), type,
 634                                           stream, show, level, flags);
 635       else if (ada_is_variant_part (type, i))
 636         {
 637           print_variant_part (type, i, outer_type, stream, show, level, flags);
 638           flds = 1;
 639         }
 640       else
 641         {
 642           flds += 1;
 643           gdb_printf (stream, "\n%*s", level + 4, "");
 644           ada_print_type (type->field (i).type (),
 645                           type->field (i).name (),
 646                           stream, show - 1, level + 4, flags);
 647           gdb_printf (stream, ";");
 648         }
 649     }
 650
 651   return flds;
 652 }
 653
 654 static void print_record_field_types_dynamic
 655   (const gdb::array_view<variant_part> &parts,
 656    int from, int to, struct type *type, struct ui_file *stream,
 657    int show, int level, const struct type_print_options *flags);
 658
 659 /* Print the choices encoded by VARIANT on STREAM.  LEVEL is the
 660    indentation level.  The type of the discriminant for VARIANT is
 661    given by DISR_TYPE.  */
 662
 663 static void
 664 print_choices (struct type *discr_type, const variant &variant,
 665                struct ui_file *stream, int level)
 666 {
 667   gdb_printf (stream, "\n%*swhen ", level, "");
 668   if (variant.is_default ())
 669     gdb_printf (stream, "others");
 670   else
 671     {
 672       bool first = true;
 673       for (const discriminant_range &range : variant.discriminants)
 674         {
 675           if (!first)
 676             gdb_printf (stream, " | ");
 677           first = false;
 678
 679           ada_print_scalar (discr_type, range.low, stream);
 680           if (range.low != range.high)
 681             ada_print_scalar (discr_type, range.high, stream);
 682         }
 683     }
 684
 685   gdb_printf (stream, " =>");
 686 }
 687
 688 /* Print a single variant part, PART, on STREAM.  TYPE is the
 689    enclosing type.  SHOW, LEVEL, and FLAGS are the usual type-printing
 690    settings.  This prints information about PART and the fields it
 691    controls.  It returns the index of the next field that should be
 692    shown -- that is, one after the last field printed by this
 693    call.  */
 694
 695 static int
 696 print_variant_part (const variant_part &part,
 697                     struct type *type, struct ui_file *stream,
 698                     int show, int level,
 699                     const struct type_print_options *flags)
 700 {
 701   struct type *discr_type = nullptr;
 702   const char *name;
 703   if (part.discriminant_index == -1)
 704     name = "?";
 705   else
 706     {
 707       name = type->field (part.discriminant_index).name ();;
 708       discr_type = type->field (part.discriminant_index).type ();
 709     }
 710
 711   gdb_printf (stream, "\n%*scase %s is", level + 4, "", name);
 712
 713   int last_field = -1;
 714   for (const variant &variant : part.variants)
 715     {
 716       print_choices (discr_type, variant, stream, level + 8);
 717
 718       if (variant.first_field == variant.last_field)
 719         gdb_printf (stream, " null;");
 720       else
 721         {
 722           print_record_field_types_dynamic (variant.parts,
 723                                             variant.first_field,
 724                                             variant.last_field, type, stream,
 725                                             show, level + 8, flags);
 726           last_field = variant.last_field;
 727         }
 728     }
 729
 730   gdb_printf (stream, "\n%*send case;", level + 4, "");
 731
 732   return last_field;
 733 }
 734
 735 /* Print some fields of TYPE to STREAM.  SHOW, LEVEL, and FLAGS are
 736    the usual type-printing settings.  PARTS is the array of variant
 737    parts that correspond to the range of fields to be printed.  FROM
 738    and TO are the range of fields to print.  */
 739
 740 static void
 741 print_record_field_types_dynamic (const gdb::array_view<variant_part> &parts,
 742                                   int from, int to,
 743                                   struct type *type, struct ui_file *stream,
 744                                   int show, int level,
 745                                   const struct type_print_options *flags)
 746 {
 747   int field = from;
 748
 749   for (const variant_part &part : parts)
 750     {
 751       if (part.variants.empty ())
 752         continue;
 753
 754       /* Print any non-varying fields.  */
 755       int first_varying = part.variants[0].first_field;
 756       print_selected_record_field_types (type, type, field,
 757                                          first_varying - 1, stream,
 758                                          show, level, flags);
 759
 760       field = print_variant_part (part, type, stream, show, level, flags);
 761     }
 762
 763   /* Print any trailing fields that we were asked to print.  */
 764   print_selected_record_field_types (type, type, field, to - 1, stream, show,
 765                                      level, flags);
 766 }
 767
 768 /* Print a description on STREAM of all fields of record or union type
 769    TYPE, as for print_selected_record_field_types, above.  */
 770
 771 static int
 772 print_record_field_types (struct type *type, struct type *outer_type,
 773                           struct ui_file *stream, int show, int level,
 774                           const struct type_print_options *flags)
 775 {
 776   struct dynamic_prop *prop = type->dyn_prop (DYN_PROP_VARIANT_PARTS);
 777   if (prop != nullptr)
 778     {
 779       if (prop->kind () == PROP_TYPE)
 780         {
 781           type = prop->original_type ();
 782           prop = type->dyn_prop (DYN_PROP_VARIANT_PARTS);
 783         }
 784       gdb_assert (prop->kind () == PROP_VARIANT_PARTS);
 785       print_record_field_types_dynamic (*prop->variant_parts (),
 786                                         0, type->num_fields (),
 787                                         type, stream, show, level, flags);
 788       return type->num_fields ();
 789     }
 790
 791   return print_selected_record_field_types (type, outer_type,
 792                                             0, type->num_fields () - 1,
 793                                             stream, show, level, flags);
 794 }
 795
 796
 797 /* Print record type TYPE on STREAM.  LEVEL is the recursion (indentation)
 798    level, in case the element type itself has nested structure, and SHOW is
 799    the number of levels of internal structure to show (see ada_print_type).  */
 800
 801 static void
 802 print_record_type (struct type *type0, struct ui_file *stream, int show,
 803                    int level, const struct type_print_options *flags)
 804 {
 805   struct type *parent_type;
 806   struct type *type;
 807
 808   type = ada_find_parallel_type (type0, "___XVE");
 809   if (type == NULL)
 810     type = type0;
 811
 812   parent_type = ada_parent_type (type);
 813   if (ada_type_name (parent_type) != NULL)
 814     {
 815       const char *parent_name = decoded_type_name (parent_type);
 816
 817       /* If we fail to decode the parent type name, then use the parent
 818          type name as is.  Not pretty, but should never happen except
 819          when the debugging info is incomplete or incorrect.  This
 820          prevents a crash trying to print a NULL pointer.  */
 821       if (parent_name == NULL)
 822         parent_name = ada_type_name (parent_type);
 823       gdb_printf (stream, "new %s with record", parent_name);
 824     }
 825   else if (parent_type == NULL && ada_is_tagged_type (type, 0))
 826     gdb_printf (stream, "tagged record");
 827   else
 828     gdb_printf (stream, "record");
 829
 830   if (show < 0)
 831     gdb_printf (stream, " ... end record");
 832   else
 833     {
 834       int flds;
 835
 836       flds = 0;
 837       if (parent_type != NULL && ada_type_name (parent_type) == NULL)
 838         flds += print_record_field_types (parent_type, parent_type,
 839                                           stream, show, level, flags);
 840       flds += print_record_field_types (type, type, stream, show, level,
 841                                         flags);
 842
 843       if (flds > 0)
 844         gdb_printf (stream, "\n%*send record", level, "");
 845       else if (flds < 0)
 846         gdb_printf (stream, _(" <incomplete type> end record"));
 847       else
 848         gdb_printf (stream, " null; end record");
 849     }
 850 }
 851
 852 /* Print the unchecked union type TYPE in something resembling Ada
 853    format on STREAM.  LEVEL is the recursion (indentation) level
 854    in case the element type itself has nested structure, and SHOW is the
 855    number of levels of internal structure to show (see ada_print_type).  */
 856 static void
 857 print_unchecked_union_type (struct type *type, struct ui_file *stream,
 858                             int show, int level,
 859                             const struct type_print_options *flags)
 860 {
 861   if (show < 0)
 862     gdb_printf (stream, "record (?) is ... end record");
 863   else if (type->num_fields () == 0)
 864     gdb_printf (stream, "record (?) is null; end record");
 865   else
 866     {
 867       gdb_printf (stream, "record (?) is\n%*scase ? is", level + 4, "");
 868
 869       print_variant_clauses (type, nullptr, type, stream, show, level + 8, flags);
 870
 871       gdb_printf (stream, "\n%*send case;\n%*send record",
 872                   level + 4, "", level, "");
 873     }
 874 }
 875
 876
 877
 878 /* Print function or procedure type TYPE on STREAM.  Make it a header
 879    for function or procedure NAME if NAME is not null.  */
 880
 881 static void
 882 print_func_type (struct type *type, struct ui_file *stream, const char *name,
 883                  const struct type_print_options *flags)
 884 {
 885   int i, len = type->num_fields ();
 886
 887   if (type->target_type () != NULL
 888       && type->target_type ()->code () == TYPE_CODE_VOID)
 889     gdb_printf (stream, "procedure");
 890   else
 891     gdb_printf (stream, "function");
 892
 893   if (name != NULL && name[0] != '\0')
 894     {
 895       gdb_puts (" ", stream);
 896       fputs_styled (name, function_name_style.style (), stream);
 897     }
 898
 899   if (len > 0)
 900     {
 901       gdb_printf (stream, " (");
 902       for (i = 0; i < len; i += 1)
 903         {
 904           if (i > 0)
 905             {
 906               gdb_puts ("; ", stream);
 907               stream->wrap_here (4);
 908             }
 909           gdb_printf (stream, "a%d: ", i + 1);
 910           ada_print_type (type->field (i).type (), "", stream, -1, 0,
 911                           flags);
 912         }
 913       gdb_printf (stream, ")");
 914     }
 915
 916   if (type->target_type () == NULL)
 917     gdb_printf (stream, " return <unknown return type>");
 918   else if (type->target_type ()->code () != TYPE_CODE_VOID)
 919     {
 920       gdb_printf (stream, " return ");
 921       ada_print_type (type->target_type (), "", stream, 0, 0, flags);
 922     }
 923 }
 924
 925
 926 /* Print a description of a type TYPE0.
 927    Output goes to STREAM (via stdio).
 928    If VARSTRING is a non-NULL, non-empty string, print as an Ada
 929        variable/field declaration.
 930    SHOW+1 is the maximum number of levels of internal type structure
 931       to show (this applies to record types, enumerated types, and
 932       array types).
 933    SHOW is the number of levels of internal type structure to show
 934       when there is a type name for the SHOWth deepest level (0th is
 935       outer level).
 936    When SHOW<0, no inner structure is shown.
 937    LEVEL indicates level of recursion (for nested definitions).  */
 938
 939 void
 940 ada_print_type (struct type *type0, const char *varstring,
 941                 struct ui_file *stream, int show, int level,
 942                 const struct type_print_options *flags)
 943 {
 944   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 945   /* If we can decode the original type name, use it.  However, there
 946      are cases where the original type is an internally-generated type
 947      with a name that can't be decoded (and whose encoded name might
 948      not actually bear any relation to the type actually declared in
 949      the sources). In that case, try using the name of the base type
 950      in its place.
 951
 952      Note that we looked at the possibility of always using the name
 953      of the base type. This does not always work, unfortunately, as
 954      there are situations where it's the base type which has an
 955      internally-generated name.  */
 956   const char *type_name = decoded_type_name (type0);
 957   if (type_name == nullptr)
 958     type_name = decoded_type_name (type);
 959   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 960
 961   if (type == NULL)
 962     {
 963       if (is_var_decl)
 964         gdb_printf (stream, "%.*s: ",
 965                     ada_name_prefix_len (varstring), varstring);
 966       fprintf_styled (stream, metadata_style.style (), "<null type?>");
 967       return;
 968     }
 969
 970   if (is_var_decl && type->code () != TYPE_CODE_FUNC)
 971     gdb_printf (stream, "%.*s: ",
 972                 ada_name_prefix_len (varstring), varstring);
 973
 974   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 975     {
 976       gdb_printf (stream, "%.*s",
 977                   ada_name_prefix_len (type_name), type_name);
 978       return;
 979     }
 980
 981   if (ada_is_aligner_type (type))
 982     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 983   else if (ada_is_constrained_packed_array_type (type)
 984            && type->code () != TYPE_CODE_PTR)
 985     print_array_type (type, stream, show, level, flags);
 986   else
 987     switch (type->code ())
 988       {
 989       default:
 990         gdb_printf (stream, "<");
 991         c_print_type (type, "", stream, show, level, language_ada, flags);
 992         gdb_printf (stream, ">");
 993         break;
 994       case TYPE_CODE_PTR:
 995       case TYPE_CODE_TYPEDEF:
 996         /* An __XVL field is not truly a pointer, so don't print
 997            "access" in this case.  */
 998         if (type->code () != TYPE_CODE_PTR
 999             || (varstring != nullptr
1000                 && strstr (varstring, "___XVL") == nullptr))
1001           gdb_printf (stream, "access ");
1002         ada_print_type (type->target_type (), "", stream, show, level,
1003                         flags);
1004         break;
1005       case TYPE_CODE_REF:
1006         gdb_printf (stream, "<ref> ");
1007         ada_print_type (type->target_type (), "", stream, show, level,
1008                         flags);
1009         break;
1010       case TYPE_CODE_ARRAY:
1011         print_array_type (type, stream, show, level, flags);
1012         break;
1013       case TYPE_CODE_BOOL:
1014         gdb_printf (stream, "(false, true)");
1015         break;
1016       case TYPE_CODE_INT:
1017         {
1018           const char *name = ada_type_name (type);
1019
1020           if (!ada_is_range_type_name (name))
1021             fprintf_styled (stream, metadata_style.style (),
1022                             _("<%s-byte integer>"),
1023                             pulongest (type->length ()));
1024           else
1025             {
1026               gdb_printf (stream, "range ");
1027               print_range_type (type, stream, 1 /* bounds_prefered_p */);
1028             }
1029         }
1030         break;
1031       case TYPE_CODE_RANGE:
1032         if (is_fixed_point_type (type))
1033           {
1034             gdb_printf (stream, "<");
1035             print_type_fixed_point (type, stream);
1036             gdb_printf (stream, ">");
1037           }
1038         else if (ada_is_modular_type (type))
1039           gdb_printf (stream, "mod %s",
1040                       int_string (ada_modulus (type), 10, 0, 0, 1));
1041         else
1042           {
1043             gdb_printf (stream, "range ");
1044             print_range (type, stream, 1 /* bounds_prefered_p */);
1045           }
1046         break;
1047       case TYPE_CODE_FLT:
1048         fprintf_styled (stream, metadata_style.style (),
1049                         _("<%s-byte float>"),
1050                         pulongest (type->length ()));
1051         break;
1052       case TYPE_CODE_ENUM:
1053         if (show < 0)
1054           gdb_printf (stream, "(...)");
1055         else
1056           print_enum_type (type, stream);
1057         break;
1058       case TYPE_CODE_STRUCT:
1059         if (ada_is_array_descriptor_type (type))
1060           print_array_type (type, stream, show, level, flags);
1061         else if (ada_is_bogus_array_descriptor (type))
1062           gdb_printf (stream,
1063                       _("array (?) of ? (<mal-formed descriptor>)"));
1064         else
1065           print_record_type (type, stream, show, level, flags);
1066         break;
1067       case TYPE_CODE_UNION:
1068         print_unchecked_union_type (type, stream, show, level, flags);
1069         break;
1070       case TYPE_CODE_FUNC:
1071         print_func_type (type, stream, varstring, flags);
1072         break;
1073       }
1074 }
1075
1076 /* Implement the la_print_typedef language method for Ada.  */
1077
1078 void
1079 ada_print_typedef (struct type *type, struct symbol *new_symbol,
1080                    struct ui_file *stream)
1081 {
1082   type = ada_check_typedef (type);
1083   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
1084 }