gdb/p-typeprint.c

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