gdb/p-typeprint.c

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