gdb/p-typeprint.c

   1 /* Support for printing Pascal types for GDB, the GNU debugger.
   2    Copyright (C) 2000-2014 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 <errno.h>
  35 #include <ctype.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 (type);
  57
  58   if (show > 0)
  59     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   CHECK_TYPEDEF (type);
 101   fprintf_filtered (stream, "type ");
 102   fprintf_filtered (stream, "%s = ", SYMBOL_PRINT_NAME (new_symbol));
 103   type_print (type, "", stream, 0);
 104   fprintf_filtered (stream, ";\n");
 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_name_no_tag (TYPE_BASECLASS (type, i));
 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 = (strncmp (physname, "__ct__", 6) == 0);
 159   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 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 (type) && show <= 0)
 215     return;
 216
 217   QUIT;
 218
 219   switch (TYPE_CODE (type))
 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_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 232         {
 233           fprintf_filtered (stream, "function  ");
 234         }
 235       else
 236         {
 237           fprintf_filtered (stream, "procedure ");
 238         }
 239
 240       if (passed_a_ptr)
 241         {
 242           fprintf_filtered (stream, " ");
 243           pascal_type_print_base (TYPE_DOMAIN_TYPE (type),
 244                                   stream, 0, passed_a_ptr, flags);
 245           fprintf_filtered (stream, "::");
 246         }
 247       break;
 248
 249     case TYPE_CODE_REF:
 250       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
 251                                         flags);
 252       fprintf_filtered (stream, "&");
 253       break;
 254
 255     case TYPE_CODE_FUNC:
 256       if (passed_a_ptr)
 257         fprintf_filtered (stream, "(");
 258
 259       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 260         {
 261           fprintf_filtered (stream, "function  ");
 262         }
 263       else
 264         {
 265           fprintf_filtered (stream, "procedure ");
 266         }
 267
 268       break;
 269
 270     case TYPE_CODE_ARRAY:
 271       if (passed_a_ptr)
 272         fprintf_filtered (stream, "(");
 273       fprintf_filtered (stream, "array ");
 274       if (TYPE_LENGTH (TYPE_TARGET_TYPE (type)) > 0
 275         && !TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 276         fprintf_filtered (stream, "[%s..%s] ",
 277                           plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
 278                           plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
 279       fprintf_filtered (stream, "of ");
 280       break;
 281
 282     case TYPE_CODE_UNDEF:
 283     case TYPE_CODE_STRUCT:
 284     case TYPE_CODE_UNION:
 285     case TYPE_CODE_ENUM:
 286     case TYPE_CODE_INT:
 287     case TYPE_CODE_FLT:
 288     case TYPE_CODE_VOID:
 289     case TYPE_CODE_ERROR:
 290     case TYPE_CODE_CHAR:
 291     case TYPE_CODE_BOOL:
 292     case TYPE_CODE_SET:
 293     case TYPE_CODE_RANGE:
 294     case TYPE_CODE_STRING:
 295     case TYPE_CODE_COMPLEX:
 296     case TYPE_CODE_TYPEDEF:
 297       /* These types need no prefix.  They are listed here so that
 298          gcc -Wall will reveal any types that haven't been handled.  */
 299       break;
 300     default:
 301       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 302       break;
 303     }
 304 }
 305
 306 static void
 307 pascal_print_func_args (struct type *type, struct ui_file *stream,
 308                         const struct type_print_options *flags)
 309 {
 310   int i, len = TYPE_NFIELDS (type);
 311
 312   if (len)
 313     {
 314       fprintf_filtered (stream, "(");
 315     }
 316   for (i = 0; i < len; i++)
 317     {
 318       if (i > 0)
 319         {
 320           fputs_filtered (", ", stream);
 321           wrap_here ("    ");
 322         }
 323       /*  Can we find if it is a var parameter ??
 324          if ( TYPE_FIELD(type, i) == )
 325          {
 326          fprintf_filtered (stream, "var ");
 327          } */
 328       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME
 329                                                            seems invalid!  */
 330                          ,stream, -1, 0, flags);
 331     }
 332   if (len)
 333     {
 334       fprintf_filtered (stream, ")");
 335     }
 336 }
 337
 338 /* Print any array sizes, function arguments or close parentheses
 339    needed after the variable name (to describe its type).
 340    Args work like pascal_type_print_varspec_prefix.  */
 341
 342 static void
 343 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 344                                   int show, int passed_a_ptr,
 345                                   int demangled_args,
 346                                   const struct type_print_options *flags)
 347 {
 348   if (type == 0)
 349     return;
 350
 351   if (TYPE_NAME (type) && show <= 0)
 352     return;
 353
 354   QUIT;
 355
 356   switch (TYPE_CODE (type))
 357     {
 358     case TYPE_CODE_ARRAY:
 359       if (passed_a_ptr)
 360         fprintf_filtered (stream, ")");
 361       break;
 362
 363     case TYPE_CODE_METHOD:
 364       if (passed_a_ptr)
 365         fprintf_filtered (stream, ")");
 366       pascal_type_print_method_args ("",
 367                                      "",
 368                                      stream);
 369       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 370         {
 371           fprintf_filtered (stream, " : ");
 372           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 373                                             stream, 0, 0, flags);
 374           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
 375                                   flags);
 376           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 377                                             passed_a_ptr, 0, flags);
 378         }
 379       break;
 380
 381     case TYPE_CODE_PTR:
 382     case TYPE_CODE_REF:
 383       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 384                                         stream, 0, 1, 0, flags);
 385       break;
 386
 387     case TYPE_CODE_FUNC:
 388       if (passed_a_ptr)
 389         fprintf_filtered (stream, ")");
 390       if (!demangled_args)
 391         pascal_print_func_args (type, stream, flags);
 392       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 393         {
 394           fprintf_filtered (stream, " : ");
 395           pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 396                                             stream, 0, 0, flags);
 397           pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
 398                                   flags);
 399           pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 400                                             passed_a_ptr, 0, flags);
 401         }
 402       break;
 403
 404     case TYPE_CODE_UNDEF:
 405     case TYPE_CODE_STRUCT:
 406     case TYPE_CODE_UNION:
 407     case TYPE_CODE_ENUM:
 408     case TYPE_CODE_INT:
 409     case TYPE_CODE_FLT:
 410     case TYPE_CODE_VOID:
 411     case TYPE_CODE_ERROR:
 412     case TYPE_CODE_CHAR:
 413     case TYPE_CODE_BOOL:
 414     case TYPE_CODE_SET:
 415     case TYPE_CODE_RANGE:
 416     case TYPE_CODE_STRING:
 417     case TYPE_CODE_COMPLEX:
 418     case TYPE_CODE_TYPEDEF:
 419       /* These types do not need a suffix.  They are listed so that
 420          gcc -Wall will report types that may not have been considered.  */
 421       break;
 422     default:
 423       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 424       break;
 425     }
 426 }
 427
 428 /* Print the name of the type (or the ultimate pointer target,
 429    function value or array element), or the description of a
 430    structure or union.
 431
 432    SHOW positive means print details about the type (e.g. enum values),
 433    and print structure elements passing SHOW - 1 for show.
 434    SHOW negative means just print the type name or struct tag if there is one.
 435    If there is no name, print something sensible but concise like
 436    "struct {...}".
 437    SHOW zero means just print the type name or struct tag if there is one.
 438    If there is no name, print something sensible but not as concise like
 439    "struct {int x; int y;}".
 440
 441    LEVEL is the number of spaces to indent by.
 442    We increase it for some recursive calls.  */
 443
 444 void
 445 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 446                         int level, const struct type_print_options *flags)
 447 {
 448   int i;
 449   int len;
 450   LONGEST lastval;
 451   enum
 452     {
 453       s_none, s_public, s_private, s_protected
 454     }
 455   section_type;
 456
 457   QUIT;
 458   wrap_here ("    ");
 459   if (type == NULL)
 460     {
 461       fputs_filtered ("<type unknown>", stream);
 462       return;
 463     }
 464
 465   /* void pointer */
 466   if ((TYPE_CODE (type) == TYPE_CODE_PTR)
 467       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 468     {
 469       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 470                       stream);
 471       return;
 472     }
 473   /* When SHOW is zero or less, and there is a valid type name, then always
 474      just print the type name directly from the type.  */
 475
 476   if (show <= 0
 477       && TYPE_NAME (type) != NULL)
 478     {
 479       fputs_filtered (TYPE_NAME (type), stream);
 480       return;
 481     }
 482
 483   CHECK_TYPEDEF (type);
 484
 485   switch (TYPE_CODE (type))
 486     {
 487     case TYPE_CODE_TYPEDEF:
 488     case TYPE_CODE_PTR:
 489     case TYPE_CODE_REF:
 490       /* case TYPE_CODE_FUNC:
 491          case TYPE_CODE_METHOD: */
 492       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
 493                               flags);
 494       break;
 495
 496     case TYPE_CODE_ARRAY:
 497       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 498                                            stream, 0, 0);
 499          pascal_type_print_base (TYPE_TARGET_TYPE (type),
 500                                  stream, show, level);
 501          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 502                                            stream, 0, 0, 0); */
 503       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
 504       break;
 505
 506     case TYPE_CODE_FUNC:
 507     case TYPE_CODE_METHOD:
 508       /*
 509          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 510          only after args !!  */
 511       break;
 512     case TYPE_CODE_STRUCT:
 513       if (TYPE_TAG_NAME (type) != NULL)
 514         {
 515           fputs_filtered (TYPE_TAG_NAME (type), stream);
 516           fputs_filtered (" = ", stream);
 517         }
 518       if (HAVE_CPLUS_STRUCT (type))
 519         {
 520           fprintf_filtered (stream, "class ");
 521         }
 522       else
 523         {
 524           fprintf_filtered (stream, "record ");
 525         }
 526       goto struct_union;
 527
 528     case TYPE_CODE_UNION:
 529       if (TYPE_TAG_NAME (type) != NULL)
 530         {
 531           fputs_filtered (TYPE_TAG_NAME (type), stream);
 532           fputs_filtered (" = ", stream);
 533         }
 534       fprintf_filtered (stream, "case <?> of ");
 535
 536     struct_union:
 537       wrap_here ("    ");
 538       if (show < 0)
 539         {
 540           /* If we just printed a tag name, no need to print anything else.  */
 541           if (TYPE_TAG_NAME (type) == NULL)
 542             fprintf_filtered (stream, "{...}");
 543         }
 544       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 545         {
 546           pascal_type_print_derivation_info (stream, type);
 547
 548           fprintf_filtered (stream, "\n");
 549           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 550             {
 551               if (TYPE_STUB (type))
 552                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 553               else
 554                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 555             }
 556
 557           /* Start off with no specific section type, so we can print
 558              one for the first field we find, and use that section type
 559              thereafter until we find another type.  */
 560
 561           section_type = s_none;
 562
 563           /* If there is a base class for this type,
 564              do not print the field that it occupies.  */
 565
 566           len = TYPE_NFIELDS (type);
 567           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 568             {
 569               QUIT;
 570               /* Don't print out virtual function table.  */
 571               if ((strncmp (TYPE_FIELD_NAME (type, i), "_vptr", 5) == 0)
 572                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 573                 continue;
 574
 575               /* If this is a pascal object or class we can print the
 576                  various section labels.  */
 577
 578               if (HAVE_CPLUS_STRUCT (type))
 579                 {
 580                   if (TYPE_FIELD_PROTECTED (type, i))
 581                     {
 582                       if (section_type != s_protected)
 583                         {
 584                           section_type = s_protected;
 585                           fprintfi_filtered (level + 2, stream,
 586                                              "protected\n");
 587                         }
 588                     }
 589                   else if (TYPE_FIELD_PRIVATE (type, i))
 590                     {
 591                       if (section_type != s_private)
 592                         {
 593                           section_type = s_private;
 594                           fprintfi_filtered (level + 2, stream, "private\n");
 595                         }
 596                     }
 597                   else
 598                     {
 599                       if (section_type != s_public)
 600                         {
 601                           section_type = s_public;
 602                           fprintfi_filtered (level + 2, stream, "public\n");
 603                         }
 604                     }
 605                 }
 606
 607               print_spaces_filtered (level + 4, stream);
 608               if (field_is_static (&TYPE_FIELD (type, i)))
 609                 fprintf_filtered (stream, "static ");
 610               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 611                                  TYPE_FIELD_NAME (type, i),
 612                                  stream, show - 1, level + 4, flags);
 613               if (!field_is_static (&TYPE_FIELD (type, i))
 614                   && TYPE_FIELD_PACKED (type, i))
 615                 {
 616                   /* It is a bitfield.  This code does not attempt
 617                      to look at the bitpos and reconstruct filler,
 618                      unnamed fields.  This would lead to misleading
 619                      results if the compiler does not put out fields
 620                      for such things (I don't know what it does).  */
 621                   fprintf_filtered (stream, " : %d",
 622                                     TYPE_FIELD_BITSIZE (type, i));
 623                 }
 624               fprintf_filtered (stream, ";\n");
 625             }
 626
 627           /* If there are both fields and methods, put a space between.  */
 628           len = TYPE_NFN_FIELDS (type);
 629           if (len && section_type != s_none)
 630             fprintf_filtered (stream, "\n");
 631
 632           /* Object pascal: print out the methods.  */
 633
 634           for (i = 0; i < len; i++)
 635             {
 636               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 637               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 638               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 639
 640               /* this is GNU C++ specific
 641                  how can we know constructor/destructor?
 642                  It might work for GNU pascal.  */
 643               for (j = 0; j < len2; j++)
 644                 {
 645                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 646
 647                   int is_constructor = (strncmp (physname, "__ct__", 6) == 0);
 648                   int is_destructor = (strncmp (physname, "__dt__", 6) == 0);
 649
 650                   QUIT;
 651                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 652                     {
 653                       if (section_type != s_protected)
 654                         {
 655                           section_type = s_protected;
 656                           fprintfi_filtered (level + 2, stream,
 657                                              "protected\n");
 658                         }
 659                     }
 660                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 661                     {
 662                       if (section_type != s_private)
 663                         {
 664                           section_type = s_private;
 665                           fprintfi_filtered (level + 2, stream, "private\n");
 666                         }
 667                     }
 668                   else
 669                     {
 670                       if (section_type != s_public)
 671                         {
 672                           section_type = s_public;
 673                           fprintfi_filtered (level + 2, stream, "public\n");
 674                         }
 675                     }
 676
 677                   print_spaces_filtered (level + 4, stream);
 678                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 679                     fprintf_filtered (stream, "static ");
 680                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 681                     {
 682                       /* Keep GDB from crashing here.  */
 683                       fprintf_filtered (stream, "<undefined type> %s;\n",
 684                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 685                       break;
 686                     }
 687
 688                   if (is_constructor)
 689                     {
 690                       fprintf_filtered (stream, "constructor ");
 691                     }
 692                   else if (is_destructor)
 693                     {
 694                       fprintf_filtered (stream, "destructor  ");
 695                     }
 696                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 697                            && TYPE_CODE (TYPE_TARGET_TYPE (
 698                                 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 699                     {
 700                       fprintf_filtered (stream, "function  ");
 701                     }
 702                   else
 703                     {
 704                       fprintf_filtered (stream, "procedure ");
 705                     }
 706                   /* This does not work, no idea why !!  */
 707
 708                   pascal_type_print_method_args (physname,
 709                                                  method_name,
 710                                                  stream);
 711
 712                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 713                       && TYPE_CODE (TYPE_TARGET_TYPE (
 714                            TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 715                     {
 716                       fputs_filtered (" : ", stream);
 717                       type_print (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)),
 718                                   "", stream, -1);
 719                     }
 720                   if (TYPE_FN_FIELD_VIRTUAL_P (f, j))
 721                     fprintf_filtered (stream, "; virtual");
 722
 723                   fprintf_filtered (stream, ";\n");
 724                 }
 725             }
 726           fprintfi_filtered (level, stream, "end");
 727         }
 728       break;
 729
 730     case TYPE_CODE_ENUM:
 731       if (TYPE_TAG_NAME (type) != NULL)
 732         {
 733           fputs_filtered (TYPE_TAG_NAME (type), stream);
 734           if (show > 0)
 735             fputs_filtered (" ", stream);
 736         }
 737       /* enum is just defined by
 738          type enume_name = (enum_member1,enum_member2,...)  */
 739       fprintf_filtered (stream, " = ");
 740       wrap_here ("    ");
 741       if (show < 0)
 742         {
 743           /* If we just printed a tag name, no need to print anything else.  */
 744           if (TYPE_TAG_NAME (type) == NULL)
 745             fprintf_filtered (stream, "(...)");
 746         }
 747       else if (show > 0 || TYPE_TAG_NAME (type) == NULL)
 748         {
 749           fprintf_filtered (stream, "(");
 750           len = TYPE_NFIELDS (type);
 751           lastval = 0;
 752           for (i = 0; i < len; i++)
 753             {
 754               QUIT;
 755               if (i)
 756                 fprintf_filtered (stream, ", ");
 757               wrap_here ("    ");
 758               fputs_filtered (TYPE_FIELD_NAME (type, i), stream);
 759               if (lastval != TYPE_FIELD_ENUMVAL (type, i))
 760                 {
 761                   fprintf_filtered (stream,
 762                                     " := %s",
 763                                     plongest (TYPE_FIELD_ENUMVAL (type, i)));
 764                   lastval = TYPE_FIELD_ENUMVAL (type, i);
 765                 }
 766               lastval++;
 767             }
 768           fprintf_filtered (stream, ")");
 769         }
 770       break;
 771
 772     case TYPE_CODE_VOID:
 773       fprintf_filtered (stream, "void");
 774       break;
 775
 776     case TYPE_CODE_UNDEF:
 777       fprintf_filtered (stream, "record <unknown>");
 778       break;
 779
 780     case TYPE_CODE_ERROR:
 781       fprintf_filtered (stream, "%s", TYPE_ERROR_NAME (type));
 782       break;
 783
 784       /* this probably does not work for enums.  */
 785     case TYPE_CODE_RANGE:
 786       {
 787         struct type *target = TYPE_TARGET_TYPE (type);
 788
 789         print_type_scalar (target, TYPE_LOW_BOUND (type), stream);
 790         fputs_filtered ("..", stream);
 791         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 792       }
 793       break;
 794
 795     case TYPE_CODE_SET:
 796       fputs_filtered ("set of ", stream);
 797       pascal_print_type (TYPE_INDEX_TYPE (type), "", stream,
 798                          show - 1, level, flags);
 799       break;
 800
 801     case TYPE_CODE_STRING:
 802       fputs_filtered ("String", stream);
 803       break;
 804
 805     default:
 806       /* Handle types not explicitly handled by the other cases,
 807          such as fundamental types.  For these, just print whatever
 808          the type name is, as recorded in the type itself.  If there
 809          is no type name, then complain.  */
 810       if (TYPE_NAME (type) != NULL)
 811         {
 812           fputs_filtered (TYPE_NAME (type), stream);
 813         }
 814       else
 815         {
 816           /* At least for dump_symtab, it is important that this not be
 817              an error ().  */
 818           fprintf_filtered (stream, "<invalid unnamed pascal type code %d>",
 819                             TYPE_CODE (type));
 820         }
 821       break;
 822     }
 823 }