gdb/ada-typeprint.c

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