gdb/p-typeprint.c

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