gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000-2020 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 /* This file is derived from p-typeprint.c */
  20
  21 #include "defs.h"
  22 #include "gdb_obstack.h"
  23 #include "bfd.h"                /* Binary File Description */
  24 #include "symtab.h"
  25 #include "gdbtypes.h"
  26 #include "expression.h"
  27 #include "value.h"
  28 #include "gdbcore.h"
  29 #include "target.h"
  30 #include "language.h"
  31 #include "p-lang.h"
  32 #include "typeprint.h"
  33 #include "gdb-demangle.h"
  34 #include <ctype.h>
  35 #include "cli/cli-style.h"
  36
  37 static void pascal_type_print_varspec_suffix (struct type *, struct ui_file *,
  38                                               int, int, int,
  39                                               const struct type_print_options *);
  40
  41 static void pascal_type_print_derivation_info (struct ui_file *,
  42                                                struct type *);
  43
  44 \f
  45
  46 /* LEVEL is the depth to indent lines by.  */
  47
  48 void
  49 pascal_print_type (struct type *type, const char *varstring,
  50                    struct ui_file *stream, int show, int level,
  51                    const struct type_print_options *flags)
  52 {
  53   enum type_code code;
  54   int demangled_args;
  55
  56   code = type->code ();
  57
  58   if (show > 0)
  59     type = check_typedef (type);
  60
  61   if ((code == TYPE_CODE_FUNC
  62        || code == TYPE_CODE_METHOD))
  63     {
  64       pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
  65     }
  66   /* first the name */
  67   fputs_filtered (varstring, stream);
  68
  69   if ((varstring != NULL && *varstring != '\0')
  70       && !(code == TYPE_CODE_FUNC
  71            || code == TYPE_CODE_METHOD))
  72     {
  73       fputs_filtered (" : ", stream);
  74     }
  75
  76   if (!(code == TYPE_CODE_FUNC
  77         || code == TYPE_CODE_METHOD))
  78     {
  79       pascal_type_print_varspec_prefix (type, stream, show, 0, flags);
  80     }
  81
  82   pascal_type_print_base (type, stream, show, level, flags);
  83   /* For demangled function names, we have the arglist as part of the name,
  84      so don't print an additional pair of ()'s.  */
  85
  86   demangled_args = varstring ? strchr (varstring, '(') != NULL : 0;
  87   pascal_type_print_varspec_suffix (type, stream, show, 0, demangled_args,
  88                                     flags);
  89
  90 }
  91
  92 /* Print a typedef using Pascal syntax.  TYPE is the underlying type.
  93    NEW_SYMBOL is the symbol naming the type.  STREAM is the stream on
  94    which to print.  */
  95
  96 void
  97 pascal_print_typedef (struct type *type, struct symbol *new_symbol,
  98                       struct ui_file *stream)
  99 {
 100   type = check_typedef (type);
 101   fprintf_filtered (stream, "type ");
 102   fprintf_filtered (stream, "%s = ", new_symbol->print_name ());
 103   type_print (type, "", stream, 0);
 104   fprintf_filtered (stream, ";");
 105 }
 106
 107 /* If TYPE is a derived type, then print out derivation information.
 108    Print only the actual base classes of this type, not the base classes
 109    of the base classes.  I.e. for the derivation hierarchy:
 110
 111    class A { int a; };
 112    class B : public A {int b; };
 113    class C : public B {int c; };
 114
 115    Print the type of class C as:
 116
 117    class C : public B {
 118    int c;
 119    }
 120
 121    Not as the following (like gdb used to), which is not legal C++ syntax for
 122    derived types and may be confused with the multiple inheritance form:
 123
 124    class C : public B : public A {
 125    int c;
 126    }
 127
 128    In general, gdb should try to print the types as closely as possible to
 129    the form that they appear in the source code.  */
 130
 131 static void
 132 pascal_type_print_derivation_info (struct ui_file *stream, struct type *type)
 133 {
 134   const char *name;
 135   int i;
 136
 137   for (i = 0; i < TYPE_N_BASECLASSES (type); i++)
 138     {
 139       fputs_filtered (i == 0 ? ": " : ", ", stream);
 140       fprintf_filtered (stream, "%s%s ",
 141                         BASETYPE_VIA_PUBLIC (type, i) ? "public" : "private",
 142                         BASETYPE_VIA_VIRTUAL (type, i) ? " virtual" : "");
 143       name = TYPE_BASECLASS (type, i)->name ();
 144       fprintf_filtered (stream, "%s", name ? name : "(null)");
 145     }
 146   if (i > 0)
 147     {
 148       fputs_filtered (" ", stream);
 149     }
 150 }
 151
 152 /* Print the Pascal method arguments ARGS to the file STREAM.  */
 153
 154 void
 155 pascal_type_print_method_args (const char *physname, const char *methodname,
 156                                struct ui_file *stream)
 157 {
 158   int is_constructor = (startswith (physname, "__ct__"));
 159   int is_destructor = (startswith (physname, "__dt__"));
 160
 161   if (is_constructor || is_destructor)
 162     {
 163       physname += 6;
 164     }
 165
 166   fputs_filtered (methodname, stream);
 167
 168   if (physname && (*physname != 0))
 169     {
 170       fputs_filtered (" (", stream);
 171       /* We must demangle this.  */
 172       while (isdigit (physname[0]))
 173         {
 174           int len = 0;
 175           int i, j;
 176           char *argname;
 177
 178           while (isdigit (physname[len]))
 179             {
 180               len++;
 181             }
 182           i = strtol (physname, &argname, 0);
 183           physname += len;
 184
 185           for (j = 0; j < i; ++j)
 186             fputc_filtered (physname[j], stream);
 187
 188           physname += i;
 189           if (physname[0] != 0)
 190             {
 191               fputs_filtered (", ", stream);
 192             }
 193         }
 194       fputs_filtered (")", stream);
 195     }
 196 }
 197
 198 /* Print any asterisks or open-parentheses needed before the
 199    variable name (to describe its type).
 200
 201    On outermost call, pass 0 for PASSED_A_PTR.
 202    On outermost call, SHOW > 0 means should ignore
 203    any typename for TYPE and show its details.
 204    SHOW is always zero on recursive calls.  */
 205
 206 void
 207 pascal_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
 208                                   int show, int passed_a_ptr,
 209                                   const struct type_print_options *flags)
 210 {
 211   if (type == 0)
 212     return;
 213
 214   if (type->name () && show <= 0)
 215     return;
 216
 217   QUIT;
 218
 219   switch (type->code ())
 220     {
 221     case TYPE_CODE_PTR:
 222       fprintf_filtered (stream, "^");
 223       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
 224                                         flags);
 225       break;                    /* Pointer should be handled normally
 226                                    in pascal.  */
 227
 228     case TYPE_CODE_METHOD:
 229       if (passed_a_ptr)
 230         fprintf_filtered (stream, "(");
 231       if (TYPE_TARGET_TYPE (type) != NULL
 232           && TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_VOID)
 233         {
 234           fprintf_filtered (stream, "function  ");
 235         }
 236       else
 237         {
 238           fprintf_filtered (stream, "procedure ");
 239         }
 240
 241       if (passed_a_ptr)
 242         {
 243           fprintf_filtered (stream, " ");
 244           pascal_type_print_base (TYPE_SELF_TYPE (type),
 245                                   stream, 0, passed_a_ptr, flags);
 246           fprintf_filtered (stream, "::");
 247         }
 248       break;
 249
 250     case TYPE_CODE_REF:
 251       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
 252                                         flags);
 253       fprintf_filtered (stream, "&");
 254       break;
 255
 256     case TYPE_CODE_FUNC:
 257       if (passed_a_ptr)
 258         fprintf_filtered (stream, "(");
 259
 260       if (TYPE_TARGET_TYPE (type) != NULL
 261           && TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_VOID)
 262         {
 263           fprintf_filtered (stream, "function  ");
 264         }
 265       else
 266         {
 267           fprintf_filtered (stream, "procedure ");
 268         }
 269
 270       break;
 271
 272     case TYPE_CODE_ARRAY:
 273       if (passed_a_ptr)
 274         fprintf_filtered (stream, "(");
 275       fprintf_filtered (stream, "array ");
 276       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 277           && type->bounds ()->high.kind () != PROP_UNDEFINED)
 278         fprintf_filtered (stream, "[%s..%s] ",
 279                           plongest (type->bounds ()->low.const_val ()),
 280                           plongest (type->bounds ()->high.const_val ()));
 281       fprintf_filtered (stream, "of ");
 282       break;
 283
 284     case TYPE_CODE_UNDEF:
 285     case TYPE_CODE_STRUCT:
 286     case TYPE_CODE_UNION:
 287     case TYPE_CODE_ENUM:
 288     case TYPE_CODE_INT:
 289     case TYPE_CODE_FLT:
 290     case TYPE_CODE_VOID:
 291     case TYPE_CODE_ERROR:
 292     case TYPE_CODE_CHAR:
 293     case TYPE_CODE_BOOL:
 294     case TYPE_CODE_SET:
 295     case TYPE_CODE_RANGE:
 296     case TYPE_CODE_STRING:
 297     case TYPE_CODE_COMPLEX:
 298     case TYPE_CODE_TYPEDEF:
 299     case TYPE_CODE_FIXED_POINT:
 300       /* These types need no prefix.  They are listed here so that
 301          gcc -Wall will reveal any types that haven't been handled.  */
 302       break;
 303     default:
 304       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 305       break;
 306     }
 307 }
 308
 309 static void
 310 pascal_print_func_args (struct type *type, struct ui_file *stream,
 311                         const struct type_print_options *flags)
 312 {
 313   int i, len = type->num_fields ();
 314
 315   if (len)
 316     {
 317       fprintf_filtered (stream, "(");
 318     }
 319   for (i = 0; i < len; i++)
 320     {
 321       if (i > 0)
 322         {
 323           fputs_filtered (", ", stream);
 324           wrap_here ("    ");
 325         }
 326       /*  Can we find if it is a var parameter ??
 327          if ( TYPE_FIELD(type, i) == )
 328          {
 329          fprintf_filtered (stream, "var ");
 330          } */
 331       pascal_print_type (type->field (i).type (), ""    /* TYPE_FIELD_NAME
 332                                                            seems invalid!  */
 333                          ,stream, -1, 0, flags);
 334     }
 335   if (len)
 336     {
 337       fprintf_filtered (stream, ")");
 338     }
 339 }
 340
 341 /* Helper for pascal_type_print_varspec_suffix to print the suffix of
 342    a function or method.  */
 343
 344 static void
 345 pascal_type_print_func_varspec_suffix  (struct type *type, struct ui_file *stream,
 346                                         int show, int passed_a_ptr,
 347                                         int demangled_args,
 348                                         const struct type_print_options *flags)
 349 {
 350   if (TYPE_TARGET_TYPE (type) == NULL
 351       || TYPE_TARGET_TYPE (type)->code () != TYPE_CODE_VOID)
 352     {
 353       fprintf_filtered (stream, " : ");
 354       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 355                                         stream, 0, 0, flags);
 356
 357       if (TYPE_TARGET_TYPE (type) == NULL)
 358         type_print_unknown_return_type (stream);
 359       else
 360         pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
 361                                 flags);
 362
 363       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 364                                         passed_a_ptr, 0, flags);
 365     }
 366 }
 367
 368 /* Print any array sizes, function arguments or close parentheses
 369    needed after the variable name (to describe its type).
 370    Args work like pascal_type_print_varspec_prefix.  */
 371
 372 static void
 373 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 374                                   int show, int passed_a_ptr,
 375                                   int demangled_args,
 376                                   const struct type_print_options *flags)
 377 {
 378   if (type == 0)
 379     return;
 380
 381   if (type->name () && show <= 0)
 382     return;
 383
 384   QUIT;
 385
 386   switch (type->code ())
 387     {
 388     case TYPE_CODE_ARRAY:
 389       if (passed_a_ptr)
 390         fprintf_filtered (stream, ")");
 391       break;
 392
 393     case TYPE_CODE_METHOD:
 394       if (passed_a_ptr)
 395         fprintf_filtered (stream, ")");
 396       pascal_type_print_method_args ("",
 397                                      "",
 398                                      stream);
 399       pascal_type_print_func_varspec_suffix (type, stream, show,
 400                                              passed_a_ptr, 0, flags);
 401       break;
 402
 403     case TYPE_CODE_PTR:
 404     case TYPE_CODE_REF:
 405       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 406                                         stream, 0, 1, 0, flags);
 407       break;
 408
 409     case TYPE_CODE_FUNC:
 410       if (passed_a_ptr)
 411         fprintf_filtered (stream, ")");
 412       if (!demangled_args)
 413         pascal_print_func_args (type, stream, flags);
 414       pascal_type_print_func_varspec_suffix (type, stream, show,
 415                                              passed_a_ptr, 0, flags);
 416       break;
 417
 418     case TYPE_CODE_UNDEF:
 419     case TYPE_CODE_STRUCT:
 420     case TYPE_CODE_UNION:
 421     case TYPE_CODE_ENUM:
 422     case TYPE_CODE_INT:
 423     case TYPE_CODE_FLT:
 424     case TYPE_CODE_VOID:
 425     case TYPE_CODE_ERROR:
 426     case TYPE_CODE_CHAR:
 427     case TYPE_CODE_BOOL:
 428     case TYPE_CODE_SET:
 429     case TYPE_CODE_RANGE:
 430     case TYPE_CODE_STRING:
 431     case TYPE_CODE_COMPLEX:
 432     case TYPE_CODE_TYPEDEF:
 433     case TYPE_CODE_FIXED_POINT:
 434       /* These types do not need a suffix.  They are listed so that
 435          gcc -Wall will report types that may not have been considered.  */
 436       break;
 437     default:
 438       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 439       break;
 440     }
 441 }
 442
 443 /* Print the name of the type (or the ultimate pointer target,
 444    function value or array element), or the description of a
 445    structure or union.
 446
 447    SHOW positive means print details about the type (e.g. enum values),
 448    and print structure elements passing SHOW - 1 for show.
 449    SHOW negative means just print the type name or struct tag if there is one.
 450    If there is no name, print something sensible but concise like
 451    "struct {...}".
 452    SHOW zero means just print the type name or struct tag if there is one.
 453    If there is no name, print something sensible but not as concise like
 454    "struct {int x; int y;}".
 455
 456    LEVEL is the number of spaces to indent by.
 457    We increase it for some recursive calls.  */
 458
 459 void
 460 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 461                         int level, const struct type_print_options *flags)
 462 {
 463   int i;
 464   int len;
 465   LONGEST lastval;
 466   enum
 467     {
 468       s_none, s_public, s_private, s_protected
 469     }
 470   section_type;
 471
 472   QUIT;
 473   wrap_here ("    ");
 474   if (type == NULL)
 475     {
 476       fputs_styled ("<type unknown>", metadata_style.style (), stream);
 477       return;
 478     }
 479
 480   /* void pointer */
 481   if ((type->code () == TYPE_CODE_PTR)
 482       && (TYPE_TARGET_TYPE (type)->code () == TYPE_CODE_VOID))
 483     {
 484       fputs_filtered (type->name () ? type->name () : "pointer",
 485                       stream);
 486       return;
 487     }
 488   /* When SHOW is zero or less, and there is a valid type name, then always
 489      just print the type name directly from the type.  */
 490
 491   if (show <= 0
 492       && type->name () != NULL)
 493     {
 494       fputs_filtered (type->name (), stream);
 495       return;
 496     }
 497
 498   type = check_typedef (type);
 499
 500   switch (type->code ())
 501     {
 502     case TYPE_CODE_TYPEDEF:
 503     case TYPE_CODE_PTR:
 504     case TYPE_CODE_REF:
 505       /* case TYPE_CODE_FUNC:
 506          case TYPE_CODE_METHOD: */
 507       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
 508                               flags);
 509       break;
 510
 511     case TYPE_CODE_ARRAY:
 512       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 513                                            stream, 0, 0);
 514          pascal_type_print_base (TYPE_TARGET_TYPE (type),
 515                                  stream, show, level);
 516          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 517                                            stream, 0, 0, 0); */
 518       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
 519       break;
 520
 521     case TYPE_CODE_FUNC:
 522     case TYPE_CODE_METHOD:
 523       /*
 524          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 525          only after args !!  */
 526       break;
 527     case TYPE_CODE_STRUCT:
 528       if (type->name () != NULL)
 529         {
 530           fputs_filtered (type->name (), stream);
 531           fputs_filtered (" = ", stream);
 532         }
 533       if (HAVE_CPLUS_STRUCT (type))
 534         {
 535           fprintf_filtered (stream, "class ");
 536         }
 537       else
 538         {
 539           fprintf_filtered (stream, "record ");
 540         }
 541       goto struct_union;
 542
 543     case TYPE_CODE_UNION:
 544       if (type->name () != NULL)
 545         {
 546           fputs_filtered (type->name (), stream);
 547           fputs_filtered (" = ", stream);
 548         }
 549       fprintf_filtered (stream, "case <?> of ");
 550
 551     struct_union:
 552       wrap_here ("    ");
 553       if (show < 0)
 554         {
 555           /* If we just printed a tag name, no need to print anything else.  */
 556           if (type->name () == NULL)
 557             fprintf_filtered (stream, "{...}");
 558         }
 559       else if (show > 0 || type->name () == NULL)
 560         {
 561           pascal_type_print_derivation_info (stream, type);
 562
 563           fprintf_filtered (stream, "\n");
 564           if ((type->num_fields () == 0) && (TYPE_NFN_FIELDS (type) == 0))
 565             {
 566               if (type->is_stub ())
 567                 fprintf_filtered (stream, "%*s<incomplete type>\n",
 568                                   level + 4, "");
 569               else
 570                 fprintf_filtered (stream, "%*s<no data fields>\n",
 571                                   level + 4, "");
 572             }
 573
 574           /* Start off with no specific section type, so we can print
 575              one for the first field we find, and use that section type
 576              thereafter until we find another type.  */
 577
 578           section_type = s_none;
 579
 580           /* If there is a base class for this type,
 581              do not print the field that it occupies.  */
 582
 583           len = type->num_fields ();
 584           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 585             {
 586               QUIT;
 587               /* Don't print out virtual function table.  */
 588               if ((startswith (TYPE_FIELD_NAME (type, i), "_vptr"))
 589                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 590                 continue;
 591
 592               /* If this is a pascal object or class we can print the
 593                  various section labels.  */
 594
 595               if (HAVE_CPLUS_STRUCT (type))
 596                 {
 597                   if (TYPE_FIELD_PROTECTED (type, i))
 598                     {
 599                       if (section_type != s_protected)
 600                         {
 601                           section_type = s_protected;
 602                           fprintf_filtered (stream, "%*sprotected\n",
 603                                             level + 2, "");
 604                         }
 605                     }
 606                   else if (TYPE_FIELD_PRIVATE (type, i))
 607                     {
 608                       if (section_type != s_private)
 609                         {
 610                           section_type = s_private;
 611                           fprintf_filtered (stream, "%*sprivate\n",
 612                                             level + 2, "");
 613                         }
 614                     }
 615                   else
 616                     {
 617                       if (section_type != s_public)
 618                         {
 619                           section_type = s_public;
 620                           fprintf_filtered (stream, "%*spublic\n",
 621                                             level + 2, "");
 622                         }
 623                     }
 624                 }
 625
 626               print_spaces_filtered (level + 4, stream);
 627               if (field_is_static (&type->field (i)))
 628                 fprintf_filtered (stream, "static ");
 629               pascal_print_type (type->field (i).type (),
 630                                  TYPE_FIELD_NAME (type, i),
 631                                  stream, show - 1, level + 4, flags);
 632               if (!field_is_static (&type->field (i))
 633                   && TYPE_FIELD_PACKED (type, i))
 634                 {
 635                   /* It is a bitfield.  This code does not attempt
 636                      to look at the bitpos and reconstruct filler,
 637                      unnamed fields.  This would lead to misleading
 638                      results if the compiler does not put out fields
 639                      for such things (I don't know what it does).  */
 640                   fprintf_filtered (stream, " : %d",
 641                                     TYPE_FIELD_BITSIZE (type, i));
 642                 }
 643               fprintf_filtered (stream, ";\n");
 644             }
 645
 646           /* If there are both fields and methods, put a space between.  */
 647           len = TYPE_NFN_FIELDS (type);
 648           if (len && section_type != s_none)
 649             fprintf_filtered (stream, "\n");
 650
 651           /* Object pascal: print out the methods.  */
 652
 653           for (i = 0; i < len; i++)
 654             {
 655               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 656               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 657               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 658
 659               /* this is GNU C++ specific
 660                  how can we know constructor/destructor?
 661                  It might work for GNU pascal.  */
 662               for (j = 0; j < len2; j++)
 663                 {
 664                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 665
 666                   int is_constructor = (startswith (physname, "__ct__"));
 667                   int is_destructor = (startswith (physname, "__dt__"));
 668
 669                   QUIT;
 670                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 671                     {
 672                       if (section_type != s_protected)
 673                         {
 674                           section_type = s_protected;
 675                           fprintf_filtered (stream, "%*sprotected\n",
 676                                             level + 2, "");
 677                         }
 678                     }
 679                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 680                     {
 681                       if (section_type != s_private)
 682                         {
 683                           section_type = s_private;
 684                           fprintf_filtered (stream, "%*sprivate\n",
 685                                             level + 2, "");
 686                         }
 687                     }
 688                   else
 689                     {
 690                       if (section_type != s_public)
 691                         {
 692                           section_type = s_public;
 693                           fprintf_filtered (stream, "%*spublic\n",
 694                                             level + 2, "");
 695                         }
 696                     }
 697
 698                   print_spaces_filtered (level + 4, stream);
 699                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 700                     fprintf_filtered (stream, "static ");
 701                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 702                     {
 703                       /* Keep GDB from crashing here.  */
 704                       fprintf_filtered (stream, "<undefined type> %s;\n",
 705                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 706                       break;
 707                     }
 708
 709                   if (is_constructor)
 710                     {
 711                       fprintf_filtered (stream, "constructor ");
 712                     }
 713                   else if (is_destructor)
 714                     {
 715                       fprintf_filtered (stream, "destructor  ");
 716                     }
 717                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 718                            && TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE(f, j))->code () != TYPE_CODE_VOID)
 719                     {
 720                       fprintf_filtered (stream, "function  ");
 721                     }
 722                   else
 723                     {
 724                       fprintf_filtered (stream, "procedure ");
 725                     }
 726                   /* This does not work, no idea why !!  */
 727
 728                   pascal_type_print_method_args (physname,
 729                                                  method_name,
 730                                                  stream);
 731
 732                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 733                       && TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE(f, j))->code () != TYPE_CODE_VOID)
 734                     {
 735                       fputs_filtered (" : ", stream);
 736                       type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
 737                                   "", stream, -1);
 738                     }
 739                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 740                     fprintf_filtered (stream, "; virtual");
 741
 742                   fprintf_filtered (stream, ";\n");
 743                 }
 744             }
 745           fprintf_filtered (stream, "%*send", level, "");
 746         }
 747       break;
 748
 749     case TYPE_CODE_ENUM:
 750       if (type->name () != NULL)
 751         {
 752           fputs_filtered (type->name (), stream);
 753           if (show > 0)
 754             fputs_filtered (" ", stream);
 755         }
 756       /* enum is just defined by
 757          type enume_name = (enum_member1,enum_member2,...)  */
 758       fprintf_filtered (stream, " = ");
 759       wrap_here ("    ");
 760       if (show < 0)
 761         {
 762           /* If we just printed a tag name, no need to print anything else.  */
 763           if (type->name () == NULL)
 764             fprintf_filtered (stream, "(...)");
 765         }
 766       else if (show > 0 || type->name () == NULL)
 767         {
 768           fprintf_filtered (stream, "(");
 769           len = type->num_fields ();
 770           lastval = 0;
 771           for (i = 0; i < len; i++)
 772             {
 773               QUIT;
 774               if (i)
 775                 fprintf_filtered (stream, ", ");
 776               wrap_here ("    ");
 777               fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 778               if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 779                 {
 780                   fprintf_filtered (stream,
 781                                     " := %s",
 782                                     plongest (TYPE_FIELD_ENUMVAL (type, i)));
 783                   lastval = TYPE_FIELD_ENUMVAL (type, i);
 784                 }
 785               lastval++;
 786             }
 787           fprintf_filtered (stream, ")");
 788         }
 789       break;
 790
 791     case TYPE_CODE_VOID:
 792       fprintf_filtered (stream, "void");
 793       break;
 794
 795     case TYPE_CODE_UNDEF:
 796       fprintf_filtered (stream, "record <unknown>");
 797       break;
 798
 799     case TYPE_CODE_ERROR:
 800       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
 801       break;
 802
 803       /* this probably does not work for enums.  */
 804     case TYPE_CODE_RANGE:
 805       {
 806         struct type *target = TYPE_TARGET_TYPE (type);
 807
 808         print_type_scalar (target, type->bounds ()->low.const_val (), stream);
 809         fputs_filtered ("..", stream);
 810         print_type_scalar (target, type->bounds ()->high.const_val (), stream);
 811       }
 812       break;
 813
 814     case TYPE_CODE_SET:
 815       fputs_filtered ("set of ", stream);
 816       pascal_print_type (type->index_type (), "", stream,
 817                          show - 1, level, flags);
 818       break;
 819
 820     case TYPE_CODE_STRING:
 821       fputs_filtered ("String", stream);
 822       break;
 823
 824     default:
 825       /* Handle types not explicitly handled by the other cases,
 826          such as fundamental types.  For these, just print whatever
 827          the type name is, as recorded in the type itself.  If there
 828          is no type name, then complain.  */
 829       if (type->name () != NULL)
 830         {
 831           fputs_filtered (type->name (), stream);
 832         }
 833       else
 834         {
 835           /* At least for dump_symtab, it is important that this not be
 836              an error ().  */
 837           fprintf_styled (stream, metadata_style.style (),
 838                           "<invalid unnamed pascal type code %d>",
 839                           type->code ());
 840         }
 841       break;
 842     }
 843 }