gdb/ada-typeprint.c

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