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