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