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