gdb/ada-typeprint.c

   1 /* Support for printing Ada types for GDB, the GNU debugger.
   2    Copyright (C) 1986-2018 Free Software Foundation, Inc.
   3
   4    This file is part of GDB.
   5
   6    This program is free software; you can redistribute it and/or modify
   7    it under the terms of the GNU General Public License as published by
   8    the Free Software Foundation; either version 3 of the License, or
   9    (at your option) any later version.
  10
  11    This program is distributed in the hope that it will be useful,
  12    but WITHOUT ANY WARRANTY; without even the implied warranty of
  13    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  14    GNU General Public License for more details.
  15
  16    You should have received a copy of the GNU General Public License
  17    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  18
  19 #include "defs.h"
  20 #include "gdb_obstack.h"
  21 #include "bfd.h"                /* Binary File Description */
  22 #include "symtab.h"
  23 #include "gdbtypes.h"
  24 #include "expression.h"
  25 #include "value.h"
  26 #include "gdbcore.h"
  27 #include "target.h"
  28 #include "command.h"
  29 #include "gdbcmd.h"
  30 #include "language.h"
  31 #include "demangle.h"
  32 #include "c-lang.h"
  33 #include "typeprint.h"
  34 #include "target-float.h"
  35 #include "ada-lang.h"
  36 #include <ctype.h>
  37
  38 static int print_selected_record_field_types (struct type *, struct type *,
  39                                               int, int,
  40                                               struct ui_file *, int, int,
  41                                               const struct type_print_options *);
  42
  43 static int print_record_field_types (struct type *, struct type *,
  44                                      struct ui_file *, int, int,
  45                                      const struct type_print_options *);
  46 \f
  47
  48
  49 static char *name_buffer;
  50 static int name_buffer_len;
  51
  52 /* The (decoded) Ada name of TYPE.  This value persists until the
  53    next call.  */
  54
  55 static char *
  56 decoded_type_name (struct type *type)
  57 {
  58   if (ada_type_name (type) == NULL)
  59     return NULL;
  60   else
  61     {
  62       const char *raw_name = ada_type_name (type);
  63       char *s, *q;
  64
  65       if (name_buffer == NULL || name_buffer_len <= strlen (raw_name))
  66         {
  67           name_buffer_len = 16 + 2 * strlen (raw_name);
  68           name_buffer = (char *) xrealloc (name_buffer, name_buffer_len);
  69         }
  70       strcpy (name_buffer, raw_name);
  71
  72       s = (char *) strstr (name_buffer, "___");
  73       if (s != NULL)
  74         *s = '\0';
  75
  76       s = name_buffer + strlen (name_buffer) - 1;
  77       while (s > name_buffer && (s[0] != '_' || s[-1] != '_'))
  78         s -= 1;
  79
  80       if (s == name_buffer)
  81         return name_buffer;
  82
  83       if (!islower (s[1]))
  84         return NULL;
  85
  86       for (s = q = name_buffer; *s != '\0'; q += 1)
  87         {
  88           if (s[0] == '_' && s[1] == '_')
  89             {
  90               *q = '.';
  91               s += 2;
  92             }
  93           else
  94             {
  95               *q = *s;
  96               s += 1;
  97             }
  98         }
  99       *q = '\0';
 100       return name_buffer;
 101     }
 102 }
 103
 104 /* Return nonzero if TYPE is a subrange type, and its bounds
 105    are identical to the bounds of its subtype.  */
 106
 107 static int
 108 type_is_full_subrange_of_target_type (struct type *type)
 109 {
 110   struct type *subtype;
 111
 112   if (TYPE_CODE (type) != TYPE_CODE_RANGE)
 113     return 0;
 114
 115   subtype = TYPE_TARGET_TYPE (type);
 116   if (subtype == NULL)
 117     return 0;
 118
 119   if (is_dynamic_type (type))
 120     return 0;
 121
 122   if (ada_discrete_type_low_bound (type)
 123       != ada_discrete_type_low_bound (subtype))
 124     return 0;
 125
 126   if (ada_discrete_type_high_bound (type)
 127       != ada_discrete_type_high_bound (subtype))
 128     return 0;
 129
 130   return 1;
 131 }
 132
 133 /* Print TYPE on STREAM, preferably as a range if BOUNDS_PREFERED_P
 134    is nonzero.  */
 135
 136 static void
 137 print_range (struct type *type, struct ui_file *stream,
 138              int bounds_prefered_p)
 139 {
 140   if (!bounds_prefered_p)
 141     {
 142       /* Try stripping all TYPE_CODE_RANGE layers whose bounds
 143          are identical to the bounds of their subtype.  When
 144          the bounds of both types match, it can allow us to
 145          print a range using the name of its base type, which
 146          is easier to read.  For instance, we would print...
 147
 148              array (character) of ...
 149
 150          ... instead of...
 151
 152              array ('["00"]' .. '["ff"]') of ...  */
 153       while (type_is_full_subrange_of_target_type (type))
 154         type = TYPE_TARGET_TYPE (type);
 155     }
 156
 157   switch (TYPE_CODE (type))
 158     {
 159     case TYPE_CODE_RANGE:
 160     case TYPE_CODE_ENUM:
 161       {
 162         LONGEST lo = 0, hi = 0; /* init for gcc -Wall */
 163         int got_error = 0;
 164
 165         TRY
 166           {
 167             lo = ada_discrete_type_low_bound (type);
 168             hi = ada_discrete_type_high_bound (type);
 169           }
 170         CATCH (e, RETURN_MASK_ERROR)
 171           {
 172             /* This can happen when the range is dynamic.  Sometimes,
 173                resolving dynamic property values requires us to have
 174                access to an actual object, which is not available
 175                when the user is using the "ptype" command on a type.
 176                Print the range as an unbounded range.  */
 177             fprintf_filtered (stream, "<>");
 178             got_error = 1;
 179           }
 180         END_CATCH
 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     fprintf_filtered (stream, " %s", name);
 783
 784   if (len > 0)
 785     {
 786       fprintf_filtered (stream, " (");
 787       for (i = 0; i < len; i += 1)
 788         {
 789           if (i > 0)
 790             {
 791               fputs_filtered ("; ", stream);
 792               wrap_here ("    ");
 793             }
 794           fprintf_filtered (stream, "a%d: ", i + 1);
 795           ada_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0,
 796                           flags);
 797         }
 798       fprintf_filtered (stream, ")");
 799     }
 800
 801   if (TYPE_TARGET_TYPE (type) == NULL)
 802     fprintf_filtered (stream, " return <unknown return type>");
 803   else if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 804     {
 805       fprintf_filtered (stream, " return ");
 806       ada_print_type (TYPE_TARGET_TYPE (type), "", stream, 0, 0, flags);
 807     }
 808 }
 809
 810
 811 /* Print a description of a type TYPE0.
 812    Output goes to STREAM (via stdio).
 813    If VARSTRING is a non-empty string, print as an Ada variable/field
 814        declaration.
 815    SHOW+1 is the maximum number of levels of internal type structure
 816       to show (this applies to record types, enumerated types, and
 817       array types).
 818    SHOW is the number of levels of internal type structure to show
 819       when there is a type name for the SHOWth deepest level (0th is
 820       outer level).
 821    When SHOW<0, no inner structure is shown.
 822    LEVEL indicates level of recursion (for nested definitions).  */
 823
 824 void
 825 ada_print_type (struct type *type0, const char *varstring,
 826                 struct ui_file *stream, int show, int level,
 827                 const struct type_print_options *flags)
 828 {
 829   struct type *type = ada_check_typedef (ada_get_base_type (type0));
 830   char *type_name = decoded_type_name (type0);
 831   int is_var_decl = (varstring != NULL && varstring[0] != '\0');
 832
 833   if (type == NULL)
 834     {
 835       if (is_var_decl)
 836         fprintf_filtered (stream, "%.*s: ",
 837                           ada_name_prefix_len (varstring), varstring);
 838       fprintf_filtered (stream, "<null type?>");
 839       return;
 840     }
 841
 842   if (show > 0)
 843     type = ada_check_typedef (type);
 844
 845   if (is_var_decl && TYPE_CODE (type) != TYPE_CODE_FUNC)
 846     fprintf_filtered (stream, "%.*s: ",
 847                       ada_name_prefix_len (varstring), varstring);
 848
 849   if (type_name != NULL && show <= 0 && !ada_is_aligner_type (type))
 850     {
 851       fprintf_filtered (stream, "%.*s",
 852                         ada_name_prefix_len (type_name), type_name);
 853       return;
 854     }
 855
 856   if (ada_is_aligner_type (type))
 857     ada_print_type (ada_aligned_type (type), "", stream, show, level, flags);
 858   else if (ada_is_constrained_packed_array_type (type)
 859            && TYPE_CODE (type) != TYPE_CODE_PTR)
 860     print_array_type (type, stream, show, level, flags);
 861   else
 862     switch (TYPE_CODE (type))
 863       {
 864       default:
 865         fprintf_filtered (stream, "<");
 866         c_print_type (type, "", stream, show, level, flags);
 867         fprintf_filtered (stream, ">");
 868         break;
 869       case TYPE_CODE_PTR:
 870       case TYPE_CODE_TYPEDEF:
 871         fprintf_filtered (stream, "access ");
 872         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 873                         flags);
 874         break;
 875       case TYPE_CODE_REF:
 876         fprintf_filtered (stream, "<ref> ");
 877         ada_print_type (TYPE_TARGET_TYPE (type), "", stream, show, level,
 878                         flags);
 879         break;
 880       case TYPE_CODE_ARRAY:
 881         print_array_type (type, stream, show, level, flags);
 882         break;
 883       case TYPE_CODE_BOOL:
 884         fprintf_filtered (stream, "(false, true)");
 885         break;
 886       case TYPE_CODE_INT:
 887         if (ada_is_fixed_point_type (type))
 888           print_fixed_point_type (type, stream);
 889         else
 890           {
 891             const char *name = ada_type_name (type);
 892
 893             if (!ada_is_range_type_name (name))
 894               fprintf_filtered (stream, _("<%d-byte integer>"),
 895                                 TYPE_LENGTH (type));
 896             else
 897               {
 898                 fprintf_filtered (stream, "range ");
 899                 print_range_type (type, stream, 1 /* bounds_prefered_p */);
 900               }
 901           }
 902         break;
 903       case TYPE_CODE_RANGE:
 904         if (ada_is_fixed_point_type (type))
 905           print_fixed_point_type (type, stream);
 906         else if (ada_is_modular_type (type))
 907           fprintf_filtered (stream, "mod %s",
 908                             int_string (ada_modulus (type), 10, 0, 0, 1));
 909         else
 910           {
 911             fprintf_filtered (stream, "range ");
 912             print_range (type, stream, 1 /* bounds_prefered_p */);
 913           }
 914         break;
 915       case TYPE_CODE_FLT:
 916         fprintf_filtered (stream, _("<%d-byte float>"), TYPE_LENGTH (type));
 917         break;
 918       case TYPE_CODE_ENUM:
 919         if (show < 0)
 920           fprintf_filtered (stream, "(...)");
 921         else
 922           print_enum_type (type, stream);
 923         break;
 924       case TYPE_CODE_STRUCT:
 925         if (ada_is_array_descriptor_type (type))
 926           print_array_type (type, stream, show, level, flags);
 927         else if (ada_is_bogus_array_descriptor (type))
 928           fprintf_filtered (stream,
 929                             _("array (?) of ? (<mal-formed descriptor>)"));
 930         else
 931           print_record_type (type, stream, show, level, flags);
 932         break;
 933       case TYPE_CODE_UNION:
 934         print_unchecked_union_type (type, stream, show, level, flags);
 935         break;
 936       case TYPE_CODE_FUNC:
 937         print_func_type (type, stream, varstring, flags);
 938         break;
 939       }
 940 }
 941
 942 /* Implement the la_print_typedef language method for Ada.  */
 943
 944 void
 945 ada_print_typedef (struct type *type, struct symbol *new_symbol,
 946                    struct ui_file *stream)
 947 {
 948   type = ada_check_typedef (type);
 949   ada_print_type (type, "", stream, 0, 0, &type_print_raw_options);
 950   fprintf_filtered (stream, "\n");
 951 }