gdb/f-typeprint.c

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