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 (type);
  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_NAME (TYPE_BASECLASS (type, i));
 144       fprintf_filtered (stream, "%s", name ? name : "(null)");
 145     }
 146   if (i > 0)
 147     {
 148       fputs_filtered (" ", stream);
 149     }
 150 }
 151
 152 /* Print the Pascal method arguments ARGS to the file STREAM.  */
 153
 154 void
 155 pascal_type_print_method_args (const char *physname, const char *methodname,
 156                                struct ui_file *stream)
 157 {
 158   int is_constructor = (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 (type) && show <= 0)
 215     return;
 216
 217   QUIT;
 218
 219   switch (TYPE_CODE (type))
 220     {
 221     case TYPE_CODE_PTR:
 222       fprintf_filtered (stream, "^");
 223       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1,
 224                                         flags);
 225       break;                    /* Pointer should be handled normally
 226                                    in pascal.  */
 227
 228     case TYPE_CODE_METHOD:
 229       if (passed_a_ptr)
 230         fprintf_filtered (stream, "(");
 231       if (TYPE_TARGET_TYPE (type) != NULL
 232           && 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_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_CODE (TYPE_TARGET_TYPE (type)) != 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_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 278         fprintf_filtered (stream, "[%s..%s] ",
 279                           plongest (TYPE_ARRAY_LOWER_BOUND_VALUE (type)),
 280                           plongest (TYPE_ARRAY_UPPER_BOUND_VALUE (type)));
 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       /* These types need no prefix.  They are listed here so that
 300          gcc -Wall will reveal any types that haven't been handled.  */
 301       break;
 302     default:
 303       error (_("type not handled in pascal_type_print_varspec_prefix()"));
 304       break;
 305     }
 306 }
 307
 308 static void
 309 pascal_print_func_args (struct type *type, struct ui_file *stream,
 310                         const struct type_print_options *flags)
 311 {
 312   int i, len = TYPE_NFIELDS (type);
 313
 314   if (len)
 315     {
 316       fprintf_filtered (stream, "(");
 317     }
 318   for (i = 0; i < len; i++)
 319     {
 320       if (i > 0)
 321         {
 322           fputs_filtered (", ", stream);
 323           wrap_here ("    ");
 324         }
 325       /*  Can we find if it is a var parameter ??
 326          if ( TYPE_FIELD(type, i) == )
 327          {
 328          fprintf_filtered (stream, "var ");
 329          } */
 330       pascal_print_type (TYPE_FIELD_TYPE (type, i), ""  /* TYPE_FIELD_NAME
 331                                                            seems invalid!  */
 332                          ,stream, -1, 0, flags);
 333     }
 334   if (len)
 335     {
 336       fprintf_filtered (stream, ")");
 337     }
 338 }
 339
 340 /* Helper for pascal_type_print_varspec_suffix to print the suffix of
 341    a function or method.  */
 342
 343 static void
 344 pascal_type_print_func_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_TARGET_TYPE (type) == NULL
 350       || TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_VOID)
 351     {
 352       fprintf_filtered (stream, " : ");
 353       pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 354                                         stream, 0, 0, flags);
 355
 356       if (TYPE_TARGET_TYPE (type) == NULL)
 357         type_print_unknown_return_type (stream);
 358       else
 359         pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0,
 360                                 flags);
 361
 362       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 363                                         passed_a_ptr, 0, flags);
 364     }
 365 }
 366
 367 /* Print any array sizes, function arguments or close parentheses
 368    needed after the variable name (to describe its type).
 369    Args work like pascal_type_print_varspec_prefix.  */
 370
 371 static void
 372 pascal_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 373                                   int show, int passed_a_ptr,
 374                                   int demangled_args,
 375                                   const struct type_print_options *flags)
 376 {
 377   if (type == 0)
 378     return;
 379
 380   if (TYPE_NAME (type) && show <= 0)
 381     return;
 382
 383   QUIT;
 384
 385   switch (TYPE_CODE (type))
 386     {
 387     case TYPE_CODE_ARRAY:
 388       if (passed_a_ptr)
 389         fprintf_filtered (stream, ")");
 390       break;
 391
 392     case TYPE_CODE_METHOD:
 393       if (passed_a_ptr)
 394         fprintf_filtered (stream, ")");
 395       pascal_type_print_method_args ("",
 396                                      "",
 397                                      stream);
 398       pascal_type_print_func_varspec_suffix (type, stream, show,
 399                                              passed_a_ptr, 0, flags);
 400       break;
 401
 402     case TYPE_CODE_PTR:
 403     case TYPE_CODE_REF:
 404       pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 405                                         stream, 0, 1, 0, flags);
 406       break;
 407
 408     case TYPE_CODE_FUNC:
 409       if (passed_a_ptr)
 410         fprintf_filtered (stream, ")");
 411       if (!demangled_args)
 412         pascal_print_func_args (type, stream, flags);
 413       pascal_type_print_func_varspec_suffix (type, stream, show,
 414                                              passed_a_ptr, 0, flags);
 415       break;
 416
 417     case TYPE_CODE_UNDEF:
 418     case TYPE_CODE_STRUCT:
 419     case TYPE_CODE_UNION:
 420     case TYPE_CODE_ENUM:
 421     case TYPE_CODE_INT:
 422     case TYPE_CODE_FLT:
 423     case TYPE_CODE_VOID:
 424     case TYPE_CODE_ERROR:
 425     case TYPE_CODE_CHAR:
 426     case TYPE_CODE_BOOL:
 427     case TYPE_CODE_SET:
 428     case TYPE_CODE_RANGE:
 429     case TYPE_CODE_STRING:
 430     case TYPE_CODE_COMPLEX:
 431     case TYPE_CODE_TYPEDEF:
 432       /* These types do not need a suffix.  They are listed so that
 433          gcc -Wall will report types that may not have been considered.  */
 434       break;
 435     default:
 436       error (_("type not handled in pascal_type_print_varspec_suffix()"));
 437       break;
 438     }
 439 }
 440
 441 /* Print the name of the type (or the ultimate pointer target,
 442    function value or array element), or the description of a
 443    structure or union.
 444
 445    SHOW positive means print details about the type (e.g. enum values),
 446    and print structure elements passing SHOW - 1 for show.
 447    SHOW negative means just print the type name or struct tag if there is one.
 448    If there is no name, print something sensible but concise like
 449    "struct {...}".
 450    SHOW zero means just print the type name or struct tag if there is one.
 451    If there is no name, print something sensible but not as concise like
 452    "struct {int x; int y;}".
 453
 454    LEVEL is the number of spaces to indent by.
 455    We increase it for some recursive calls.  */
 456
 457 void
 458 pascal_type_print_base (struct type *type, struct ui_file *stream, int show,
 459                         int level, const struct type_print_options *flags)
 460 {
 461   int i;
 462   int len;
 463   LONGEST lastval;
 464   enum
 465     {
 466       s_none, s_public, s_private, s_protected
 467     }
 468   section_type;
 469
 470   QUIT;
 471   wrap_here ("    ");
 472   if (type == NULL)
 473     {
 474       fputs_styled ("<type unknown>", metadata_style.style (), stream);
 475       return;
 476     }
 477
 478   /* void pointer */
 479   if ((TYPE_CODE (type) == TYPE_CODE_PTR)
 480       && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_VOID))
 481     {
 482       fputs_filtered (TYPE_NAME (type) ? TYPE_NAME (type) : "pointer",
 483                       stream);
 484       return;
 485     }
 486   /* When SHOW is zero or less, and there is a valid type name, then always
 487      just print the type name directly from the type.  */
 488
 489   if (show <= 0
 490       && TYPE_NAME (type) != NULL)
 491     {
 492       fputs_filtered (TYPE_NAME (type), stream);
 493       return;
 494     }
 495
 496   type = check_typedef (type);
 497
 498   switch (TYPE_CODE (type))
 499     {
 500     case TYPE_CODE_TYPEDEF:
 501     case TYPE_CODE_PTR:
 502     case TYPE_CODE_REF:
 503       /* case TYPE_CODE_FUNC:
 504          case TYPE_CODE_METHOD: */
 505       pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level,
 506                               flags);
 507       break;
 508
 509     case TYPE_CODE_ARRAY:
 510       /* pascal_type_print_varspec_prefix (TYPE_TARGET_TYPE (type),
 511                                            stream, 0, 0);
 512          pascal_type_print_base (TYPE_TARGET_TYPE (type),
 513                                  stream, show, level);
 514          pascal_type_print_varspec_suffix (TYPE_TARGET_TYPE (type),
 515                                            stream, 0, 0, 0); */
 516       pascal_print_type (TYPE_TARGET_TYPE (type), NULL, stream, 0, 0, flags);
 517       break;
 518
 519     case TYPE_CODE_FUNC:
 520     case TYPE_CODE_METHOD:
 521       /*
 522          pascal_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 523          only after args !!  */
 524       break;
 525     case TYPE_CODE_STRUCT:
 526       if (TYPE_NAME (type) != NULL)
 527         {
 528           fputs_filtered (TYPE_NAME (type), stream);
 529           fputs_filtered (" = ", stream);
 530         }
 531       if (HAVE_CPLUS_STRUCT (type))
 532         {
 533           fprintf_filtered (stream, "class ");
 534         }
 535       else
 536         {
 537           fprintf_filtered (stream, "record ");
 538         }
 539       goto struct_union;
 540
 541     case TYPE_CODE_UNION:
 542       if (TYPE_NAME (type) != NULL)
 543         {
 544           fputs_filtered (TYPE_NAME (type), stream);
 545           fputs_filtered (" = ", stream);
 546         }
 547       fprintf_filtered (stream, "case <?> of ");
 548
 549     struct_union:
 550       wrap_here ("    ");
 551       if (show < 0)
 552         {
 553           /* If we just printed a tag name, no need to print anything else.  */
 554           if (TYPE_NAME (type) == NULL)
 555             fprintf_filtered (stream, "{...}");
 556         }
 557       else if (show > 0 || TYPE_NAME (type) == NULL)
 558         {
 559           pascal_type_print_derivation_info (stream, type);
 560
 561           fprintf_filtered (stream, "\n");
 562           if ((TYPE_NFIELDS (type) == 0) && (TYPE_NFN_FIELDS (type) == 0))
 563             {
 564               if (TYPE_STUB (type))
 565                 fprintfi_filtered (level + 4, stream, "<incomplete type>\n");
 566               else
 567                 fprintfi_filtered (level + 4, stream, "<no data fields>\n");
 568             }
 569
 570           /* Start off with no specific section type, so we can print
 571              one for the first field we find, and use that section type
 572              thereafter until we find another type.  */
 573
 574           section_type = s_none;
 575
 576           /* If there is a base class for this type,
 577              do not print the field that it occupies.  */
 578
 579           len = TYPE_NFIELDS (type);
 580           for (i = TYPE_N_BASECLASSES (type); i < len; i++)
 581             {
 582               QUIT;
 583               /* Don't print out virtual function table.  */
 584               if ((startswith (TYPE_FIELD_NAME (type, i), "_vptr"))
 585                   && is_cplus_marker ((TYPE_FIELD_NAME (type, i))[5]))
 586                 continue;
 587
 588               /* If this is a pascal object or class we can print the
 589                  various section labels.  */
 590
 591               if (HAVE_CPLUS_STRUCT (type))
 592                 {
 593                   if (TYPE_FIELD_PROTECTED (type, i))
 594                     {
 595                       if (section_type != s_protected)
 596                         {
 597                           section_type = s_protected;
 598                           fprintfi_filtered (level + 2, stream,
 599                                              "protected\n");
 600                         }
 601                     }
 602                   else if (TYPE_FIELD_PRIVATE (type, i))
 603                     {
 604                       if (section_type != s_private)
 605                         {
 606                           section_type = s_private;
 607                           fprintfi_filtered (level + 2, stream, "private\n");
 608                         }
 609                     }
 610                   else
 611                     {
 612                       if (section_type != s_public)
 613                         {
 614                           section_type = s_public;
 615                           fprintfi_filtered (level + 2, stream, "public\n");
 616                         }
 617                     }
 618                 }
 619
 620               print_spaces_filtered (level + 4, stream);
 621               if (field_is_static (&TYPE_FIELD (type, i)))
 622                 fprintf_filtered (stream, "static ");
 623               pascal_print_type (TYPE_FIELD_TYPE (type, i),
 624                                  TYPE_FIELD_NAME (type, i),
 625                                  stream, show - 1, level + 4, flags);
 626               if (!field_is_static (&TYPE_FIELD (type, i))
 627                   && TYPE_FIELD_PACKED (type, i))
 628                 {
 629                   /* It is a bitfield.  This code does not attempt
 630                      to look at the bitpos and reconstruct filler,
 631                      unnamed fields.  This would lead to misleading
 632                      results if the compiler does not put out fields
 633                      for such things (I don't know what it does).  */
 634                   fprintf_filtered (stream, " : %d",
 635                                     TYPE_FIELD_BITSIZE (type, i));
 636                 }
 637               fprintf_filtered (stream, ";\n");
 638             }
 639
 640           /* If there are both fields and methods, put a space between.  */
 641           len = TYPE_NFN_FIELDS (type);
 642           if (len && section_type != s_none)
 643             fprintf_filtered (stream, "\n");
 644
 645           /* Object pascal: print out the methods.  */
 646
 647           for (i = 0; i < len; i++)
 648             {
 649               struct fn_field *f = TYPE_FN_FIELDLIST1 (type, i);
 650               int j, len2 = TYPE_FN_FIELDLIST_LENGTH (type, i);
 651               const char *method_name = TYPE_FN_FIELDLIST_NAME (type, i);
 652
 653               /* this is GNU C++ specific
 654                  how can we know constructor/destructor?
 655                  It might work for GNU pascal.  */
 656               for (j = 0; j < len2; j++)
 657                 {
 658                   const char *physname = TYPE_FN_FIELD_PHYSNAME (f, j);
 659
 660                   int is_constructor = (startswith (physname, "__ct__"));
 661                   int is_destructor = (startswith (physname, "__dt__"));
 662
 663                   QUIT;
 664                   if (TYPE_FN_FIELD_PROTECTED (f, j))
 665                     {
 666                       if (section_type != s_protected)
 667                         {
 668                           section_type = s_protected;
 669                           fprintfi_filtered (level + 2, stream,
 670                                              "protected\n");
 671                         }
 672                     }
 673                   else if (TYPE_FN_FIELD_PRIVATE (f, j))
 674                     {
 675                       if (section_type != s_private)
 676                         {
 677                           section_type = s_private;
 678                           fprintfi_filtered (level + 2, stream, "private\n");
 679                         }
 680                     }
 681                   else
 682                     {
 683                       if (section_type != s_public)
 684                         {
 685                           section_type = s_public;
 686                           fprintfi_filtered (level + 2, stream, "public\n");
 687                         }
 688                     }
 689
 690                   print_spaces_filtered (level + 4, stream);
 691                   if (TYPE_FN_FIELD_STATIC_P (f, j))
 692                     fprintf_filtered (stream, "static ");
 693                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) == 0)
 694                     {
 695                       /* Keep GDB from crashing here.  */
 696                       fprintf_filtered (stream, "<undefined type> %s;\n",
 697                                         TYPE_FN_FIELD_PHYSNAME (f, j));
 698                       break;
 699                     }
 700
 701                   if (is_constructor)
 702                     {
 703                       fprintf_filtered (stream, "constructor ");
 704                     }
 705                   else if (is_destructor)
 706                     {
 707                       fprintf_filtered (stream, "destructor  ");
 708                     }
 709                   else if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 710                            && TYPE_CODE (TYPE_TARGET_TYPE (
 711                                 TYPE_FN_FIELD_TYPE (f, j))) != TYPE_CODE_VOID)
 712                     {
 713                       fprintf_filtered (stream, "function  ");
 714                     }
 715                   else
 716                     {
 717                       fprintf_filtered (stream, "procedure ");
 718                     }
 719                   /* This does not work, no idea why !!  */
 720
 721                   pascal_type_print_method_args (physname,
 722                                                  method_name,
 723                                                  stream);
 724
 725                   if (TYPE_TARGET_TYPE (TYPE_FN_FIELD_TYPE (f, j)) != 0
 726                       && TYPE_CODE (TYPE_TARGET_TYPE (
 727                            TYPE_FN_FIELD_TYPE (f, j))) != 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 (type) != NULL)
 745         {
 746           fputs_filtered (TYPE_NAME (type), 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 (type) == NULL)
 758             fprintf_filtered (stream, "(...)");
 759         }
 760       else if (show > 0 || TYPE_NAME (type) == NULL)
 761         {
 762           fprintf_filtered (stream, "(");
 763           len = TYPE_NFIELDS (type);
 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_LOW_BOUND (type), stream);
 803         fputs_filtered ("..", stream);
 804         print_type_scalar (target, TYPE_HIGH_BOUND (type), stream);
 805       }
 806       break;
 807
 808     case TYPE_CODE_SET:
 809       fputs_filtered ("set of ", stream);
 810       pascal_print_type (TYPE_INDEX_TYPE (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 (type) != NULL)
 824         {
 825           fputs_filtered (TYPE_NAME (type), 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 (type));
 834         }
 835       break;
 836     }
 837 }