gdb/f-typeprint.c

   1 /* Support for printing Fortran types for GDB, the GNU debugger.
   2
   3    Copyright (C) 1986-2019 Free Software Foundation, Inc.
   4
   5    Contributed by Motorola.  Adapted from the C version by Farooq Butt
   6    (fmbutt@engage.sps.mot.com).
   7
   8    This file is part of GDB.
   9
  10    This program is free software; you can redistribute it and/or modify
  11    it under the terms of the GNU General Public License as published by
  12    the Free Software Foundation; either version 3 of the License, or
  13    (at your option) any later version.
  14
  15    This program is distributed in the hope that it will be useful,
  16    but WITHOUT ANY WARRANTY; without even the implied warranty of
  17    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18    GNU General Public License for more details.
  19
  20    You should have received a copy of the GNU General Public License
  21    along with this program.  If not, see <http://www.gnu.org/licenses/>.  */
  22
  23 #include "defs.h"
  24 #include "gdb_obstack.h"
  25 #include "bfd.h"
  26 #include "symtab.h"
  27 #include "gdbtypes.h"
  28 #include "expression.h"
  29 #include "value.h"
  30 #include "gdbcore.h"
  31 #include "target.h"
  32 #include "f-lang.h"
  33 #include "typeprint.h"
  34 #include "cli/cli-style.h"
  35
  36 #if 0                           /* Currently unused.  */
  37 static void f_type_print_args (struct type *, struct ui_file *);
  38 #endif
  39
  40 static void f_type_print_varspec_suffix (struct type *, struct ui_file *, int,
  41                                          int, int, int, bool);
  42
  43 void f_type_print_varspec_prefix (struct type *, struct ui_file *,
  44                                   int, int);
  45
  46 void f_type_print_base (struct type *, struct ui_file *, int, int);
  47 \f
  48
  49 /* See documentation in f-lang.h.  */
  50
  51 void
  52 f_print_typedef (struct type *type, struct symbol *new_symbol,
  53                  struct ui_file *stream)
  54 {
  55   type = check_typedef (type);
  56   f_print_type (type, "", stream, 0, 0, &type_print_raw_options);
  57   fprintf_filtered (stream, "\n");
  58 }
  59
  60 /* LEVEL is the depth to indent lines by.  */
  61
  62 void
  63 f_print_type (struct type *type, const char *varstring, struct ui_file *stream,
  64               int show, int level, const struct type_print_options *flags)
  65 {
  66   enum type_code code;
  67
  68   f_type_print_base (type, stream, show, level);
  69   code = TYPE_CODE (type);
  70   if ((varstring != NULL && *varstring != '\0')
  71       /* Need a space if going to print stars or brackets; but not if we
  72          will print just a type name.  */
  73       || ((show > 0
  74            || TYPE_NAME (type) == 0)
  75           && (code == TYPE_CODE_FUNC
  76               || code == TYPE_CODE_METHOD
  77               || code == TYPE_CODE_ARRAY
  78               || ((code == TYPE_CODE_PTR
  79                    || code == TYPE_CODE_REF)
  80                   && (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_FUNC
  81                       || (TYPE_CODE (TYPE_TARGET_TYPE (type))
  82                           == TYPE_CODE_METHOD)
  83                       || (TYPE_CODE (TYPE_TARGET_TYPE (type))
  84                           == TYPE_CODE_ARRAY))))))
  85     fputs_filtered (" ", stream);
  86   f_type_print_varspec_prefix (type, stream, show, 0);
  87
  88   if (varstring != NULL)
  89     {
  90       int demangled_args;
  91
  92       fputs_filtered (varstring, stream);
  93
  94       /* For demangled function names, we have the arglist as part of the name,
  95          so don't print an additional pair of ()'s.  */
  96
  97       demangled_args = (*varstring != '\0'
  98                         && varstring[strlen (varstring) - 1] == ')');
  99       f_type_print_varspec_suffix (type, stream, show, 0, demangled_args, 0, false);
 100    }
 101 }
 102
 103 /* Print any asterisks or open-parentheses needed before the
 104    variable name (to describe its type).
 105
 106    On outermost call, pass 0 for PASSED_A_PTR.
 107    On outermost call, SHOW > 0 means should ignore
 108    any typename for TYPE and show its details.
 109    SHOW is always zero on recursive calls.  */
 110
 111 void
 112 f_type_print_varspec_prefix (struct type *type, struct ui_file *stream,
 113                              int show, int passed_a_ptr)
 114 {
 115   if (type == 0)
 116     return;
 117
 118   if (TYPE_NAME (type) && show <= 0)
 119     return;
 120
 121   QUIT;
 122
 123   switch (TYPE_CODE (type))
 124     {
 125     case TYPE_CODE_PTR:
 126       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 1);
 127       break;
 128
 129     case TYPE_CODE_FUNC:
 130       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 131       if (passed_a_ptr)
 132         fprintf_filtered (stream, "(");
 133       break;
 134
 135     case TYPE_CODE_ARRAY:
 136       f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type), stream, 0, 0);
 137       break;
 138
 139     case TYPE_CODE_UNDEF:
 140     case TYPE_CODE_STRUCT:
 141     case TYPE_CODE_UNION:
 142     case TYPE_CODE_ENUM:
 143     case TYPE_CODE_INT:
 144     case TYPE_CODE_FLT:
 145     case TYPE_CODE_VOID:
 146     case TYPE_CODE_ERROR:
 147     case TYPE_CODE_CHAR:
 148     case TYPE_CODE_BOOL:
 149     case TYPE_CODE_SET:
 150     case TYPE_CODE_RANGE:
 151     case TYPE_CODE_STRING:
 152     case TYPE_CODE_METHOD:
 153     case TYPE_CODE_REF:
 154     case TYPE_CODE_COMPLEX:
 155     case TYPE_CODE_TYPEDEF:
 156       /* These types need no prefix.  They are listed here so that
 157          gcc -Wall will reveal any types that haven't been handled.  */
 158       break;
 159     }
 160 }
 161
 162 /* Print any array sizes, function arguments or close parentheses
 163    needed after the variable name (to describe its type).
 164    Args work like c_type_print_varspec_prefix.
 165
 166    PRINT_RANK_ONLY is true when TYPE is an array which should be printed
 167    without the upper and lower bounds being specified, this will occur
 168    when the array is not allocated or not associated and so there are no
 169    known upper or lower bounds.  */
 170
 171 static void
 172 f_type_print_varspec_suffix (struct type *type, struct ui_file *stream,
 173                              int show, int passed_a_ptr, int demangled_args,
 174                              int arrayprint_recurse_level, bool print_rank_only)
 175 {
 176   /* No static variables are permitted as an error call may occur during
 177      execution of this function.  */
 178
 179   if (type == 0)
 180     return;
 181
 182   if (TYPE_NAME (type) && show <= 0)
 183     return;
 184
 185   QUIT;
 186
 187   switch (TYPE_CODE (type))
 188     {
 189     case TYPE_CODE_ARRAY:
 190       arrayprint_recurse_level++;
 191
 192       if (arrayprint_recurse_level == 1)
 193         fprintf_filtered (stream, "(");
 194
 195       if (type_not_associated (type))
 196         print_rank_only = true;
 197       else if (type_not_allocated (type))
 198         print_rank_only = true;
 199       else if ((TYPE_ASSOCIATED_PROP (type)
 200                 && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type)))
 201                || (TYPE_ALLOCATED_PROP (type)
 202                    && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type)))
 203                || (TYPE_DATA_LOCATION (type)
 204                    && PROP_CONST != TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type))))
 205         {
 206           /* This case exist when we ptype a typename which has the dynamic
 207              properties but cannot be resolved as there is no object.  */
 208           print_rank_only = true;
 209         }
 210
 211       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 212         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 213                                      0, 0, arrayprint_recurse_level,
 214                                      print_rank_only);
 215
 216       if (print_rank_only)
 217         fprintf_filtered (stream, ":");
 218       else
 219         {
 220           LONGEST lower_bound = f77_get_lowerbound (type);
 221           if (lower_bound != 1) /* Not the default.  */
 222             fprintf_filtered (stream, "%s:", plongest (lower_bound));
 223
 224           /* Make sure that, if we have an assumed size array, we
 225                print out a warning and print the upperbound as '*'.  */
 226
 227           if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 228             fprintf_filtered (stream, "*");
 229           else
 230             {
 231               LONGEST upper_bound = f77_get_upperbound (type);
 232
 233               fputs_filtered (plongest (upper_bound), stream);
 234             }
 235         }
 236
 237       if (TYPE_CODE (TYPE_TARGET_TYPE (type)) != TYPE_CODE_ARRAY)
 238         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 239                                      0, 0, arrayprint_recurse_level,
 240                                      print_rank_only);
 241
 242       if (arrayprint_recurse_level == 1)
 243         fprintf_filtered (stream, ")");
 244       else
 245         fprintf_filtered (stream, ",");
 246       arrayprint_recurse_level--;
 247       break;
 248
 249     case TYPE_CODE_PTR:
 250     case TYPE_CODE_REF:
 251       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0, 1, 0,
 252                                    arrayprint_recurse_level, false);
 253       fprintf_filtered (stream, " )");
 254       break;
 255
 256     case TYPE_CODE_FUNC:
 257       {
 258         int i, nfields = TYPE_NFIELDS (type);
 259
 260         f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 261                                      passed_a_ptr, 0,
 262                                      arrayprint_recurse_level, false);
 263         if (passed_a_ptr)
 264           fprintf_filtered (stream, ") ");
 265         fprintf_filtered (stream, "(");
 266         if (nfields == 0 && TYPE_PROTOTYPED (type))
 267           f_print_type (builtin_f_type (get_type_arch (type))->builtin_void,
 268                         "", stream, -1, 0, 0);
 269         else
 270           for (i = 0; i < nfields; i++)
 271             {
 272               if (i > 0)
 273                 {
 274                   fputs_filtered (", ", stream);
 275                   wrap_here ("    ");
 276                 }
 277               f_print_type (TYPE_FIELD_TYPE (type, i), "", stream, -1, 0, 0);
 278             }
 279         fprintf_filtered (stream, ")");
 280       }
 281       break;
 282
 283     case TYPE_CODE_UNDEF:
 284     case TYPE_CODE_STRUCT:
 285     case TYPE_CODE_UNION:
 286     case TYPE_CODE_ENUM:
 287     case TYPE_CODE_INT:
 288     case TYPE_CODE_FLT:
 289     case TYPE_CODE_VOID:
 290     case TYPE_CODE_ERROR:
 291     case TYPE_CODE_CHAR:
 292     case TYPE_CODE_BOOL:
 293     case TYPE_CODE_SET:
 294     case TYPE_CODE_RANGE:
 295     case TYPE_CODE_STRING:
 296     case TYPE_CODE_METHOD:
 297     case TYPE_CODE_COMPLEX:
 298     case TYPE_CODE_TYPEDEF:
 299       /* These types do not need a suffix.  They are listed so that
 300          gcc -Wall will report types that may not have been considered.  */
 301       break;
 302     }
 303 }
 304
 305 /* Print the name of the type (or the ultimate pointer target,
 306    function value or array element), or the description of a
 307    structure or union.
 308
 309    SHOW nonzero means don't print this type as just its name;
 310    show its real definition even if it has a name.
 311    SHOW zero means print just typename or struct tag if there is one
 312    SHOW negative means abbreviate structure elements.
 313    SHOW is decremented for printing of structure elements.
 314
 315    LEVEL is the depth to indent by.
 316    We increase it for some recursive calls.  */
 317
 318 void
 319 f_type_print_base (struct type *type, struct ui_file *stream, int show,
 320                    int level)
 321 {
 322   int index;
 323
 324   QUIT;
 325
 326   wrap_here ("    ");
 327   if (type == NULL)
 328     {
 329       fputs_styled ("<type unknown>", metadata_style.style (), stream);
 330       return;
 331     }
 332
 333   /* When SHOW is zero or less, and there is a valid type name, then always
 334      just print the type name directly from the type.  */
 335
 336   if ((show <= 0) && (TYPE_NAME (type) != NULL))
 337     {
 338       const char *prefix = "";
 339       if (TYPE_CODE (type) == TYPE_CODE_UNION)
 340         prefix = "Type, C_Union :: ";
 341       else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 342         prefix = "Type ";
 343       fprintfi_filtered (level, stream, "%s%s", prefix, TYPE_NAME (type));
 344       return;
 345     }
 346
 347   if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
 348     type = check_typedef (type);
 349
 350   switch (TYPE_CODE (type))
 351     {
 352     case TYPE_CODE_TYPEDEF:
 353       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
 354       break;
 355
 356     case TYPE_CODE_ARRAY:
 357       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 358       break;
 359     case TYPE_CODE_FUNC:
 360       if (TYPE_TARGET_TYPE (type) == NULL)
 361         type_print_unknown_return_type (stream);
 362       else
 363         f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 364       break;
 365
 366     case TYPE_CODE_PTR:
 367       fprintfi_filtered (level, stream, "PTR TO -> ( ");
 368       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 369       break;
 370
 371     case TYPE_CODE_REF:
 372       fprintfi_filtered (level, stream, "REF TO -> ( ");
 373       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 374       break;
 375
 376     case TYPE_CODE_VOID:
 377       {
 378         gdbarch *gdbarch = get_type_arch (type);
 379         struct type *void_type = builtin_f_type (gdbarch)->builtin_void;
 380         fprintfi_filtered (level, stream, "%s", TYPE_NAME (void_type));
 381       }
 382       break;
 383
 384     case TYPE_CODE_UNDEF:
 385       fprintfi_filtered (level, stream, "struct <unknown>");
 386       break;
 387
 388     case TYPE_CODE_ERROR:
 389       fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
 390       break;
 391
 392     case TYPE_CODE_RANGE:
 393       /* This should not occur.  */
 394       fprintfi_filtered (level, stream, "<range type>");
 395       break;
 396
 397     case TYPE_CODE_CHAR:
 398     case TYPE_CODE_INT:
 399       /* There may be some character types that attempt to come
 400          through as TYPE_CODE_INT since dbxstclass.h is so
 401          C-oriented, we must change these to "character" from "char".  */
 402
 403       if (strcmp (TYPE_NAME (type), "char") == 0)
 404         fprintfi_filtered (level, stream, "character");
 405       else
 406         goto default_case;
 407       break;
 408
 409     case TYPE_CODE_STRING:
 410       /* Strings may have dynamic upperbounds (lengths) like arrays.  */
 411
 412       if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 413         fprintfi_filtered (level, stream, "character*(*)");
 414       else
 415         {
 416           LONGEST upper_bound = f77_get_upperbound (type);
 417
 418           fprintf_filtered (stream, "character*%s", pulongest (upper_bound));
 419         }
 420       break;
 421
 422     case TYPE_CODE_STRUCT:
 423     case TYPE_CODE_UNION:
 424       if (TYPE_CODE (type) == TYPE_CODE_UNION)
 425         fprintfi_filtered (level, stream, "Type, C_Union :: ");
 426       else
 427         fprintfi_filtered (level, stream, "Type ");
 428       fputs_filtered (TYPE_NAME (type), stream);
 429       /* According to the definition,
 430          we only print structure elements in case show > 0.  */
 431       if (show > 0)
 432         {
 433           fputs_filtered ("\n", stream);
 434           for (index = 0; index < TYPE_NFIELDS (type); index++)
 435             {
 436               f_type_print_base (TYPE_FIELD_TYPE (type, index), stream,
 437                                  show - 1, level + 4);
 438               fputs_filtered (" :: ", stream);
 439               fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
 440               f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
 441                                            stream, show - 1, 0, 0, 0, false);
 442               fputs_filtered ("\n", stream);
 443             }
 444           fprintfi_filtered (level, stream, "End Type ");
 445           fputs_filtered (TYPE_NAME (type), stream);
 446         }
 447       break;
 448
 449     case TYPE_CODE_MODULE:
 450       fprintfi_filtered (level, stream, "module %s", TYPE_NAME (type));
 451       break;
 452
 453     default_case:
 454     default:
 455       /* Handle types not explicitly handled by the other cases,
 456          such as fundamental types.  For these, just print whatever
 457          the type name is, as recorded in the type itself.  If there
 458          is no type name, then complain.  */
 459       if (TYPE_NAME (type) != NULL)
 460         fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
 461       else
 462         error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
 463       break;
 464     }
 465
 466   if (TYPE_IS_ALLOCATABLE (type))
 467     fprintf_filtered (stream, ", allocatable");
 468 }