gdb/f-typeprint.c

   1 /* Support for printing Fortran types for GDB, the GNU debugger.
   2
   3    Copyright (C) 1986-2018 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   int upper_bound, lower_bound;
 165
 166   /* No static variables are permitted as an error call may occur during
 167      execution of this function.  */
 168
 169   if (type == 0)
 170     return;
 171
 172   if (TYPE_NAME (type) && show <= 0)
 173     return;
 174
 175   QUIT;
 176
 177   switch (TYPE_CODE (type))
 178     {
 179     case TYPE_CODE_ARRAY:
 180       arrayprint_recurse_level++;
 181
 182       if (arrayprint_recurse_level == 1)
 183         fprintf_filtered (stream, "(");
 184
 185       if (type_not_associated (type))
 186         val_print_not_associated (stream);
 187       else if (type_not_allocated (type))
 188         val_print_not_allocated (stream);
 189       else
 190         {
 191           if (TYPE_CODE (TYPE_TARGET_TYPE (type)) == TYPE_CODE_ARRAY)
 192             f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 193                                         0, 0, arrayprint_recurse_level);
 194
 195           lower_bound = f77_get_lowerbound (type);
 196           if (lower_bound != 1) /* Not the default.  */
 197             fprintf_filtered (stream, "%d:", lower_bound);
 198
 199           /* Make sure that, if we have an assumed size array, we
 200              print out a warning and print the upperbound as '*'.  */
 201
 202           if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 203             fprintf_filtered (stream, "*");
 204           else
 205             {
 206               upper_bound = f77_get_upperbound (type);
 207               fprintf_filtered (stream, "%d", upper_bound);
 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       f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type), stream, 0,
 230                                    passed_a_ptr, 0, arrayprint_recurse_level);
 231       if (passed_a_ptr)
 232         fprintf_filtered (stream, ")");
 233
 234       fprintf_filtered (stream, "()");
 235       break;
 236
 237     case TYPE_CODE_UNDEF:
 238     case TYPE_CODE_STRUCT:
 239     case TYPE_CODE_UNION:
 240     case TYPE_CODE_ENUM:
 241     case TYPE_CODE_INT:
 242     case TYPE_CODE_FLT:
 243     case TYPE_CODE_VOID:
 244     case TYPE_CODE_ERROR:
 245     case TYPE_CODE_CHAR:
 246     case TYPE_CODE_BOOL:
 247     case TYPE_CODE_SET:
 248     case TYPE_CODE_RANGE:
 249     case TYPE_CODE_STRING:
 250     case TYPE_CODE_METHOD:
 251     case TYPE_CODE_COMPLEX:
 252     case TYPE_CODE_TYPEDEF:
 253       /* These types do not need a suffix.  They are listed so that
 254          gcc -Wall will report types that may not have been considered.  */
 255       break;
 256     }
 257 }
 258
 259 /* Print the name of the type (or the ultimate pointer target,
 260    function value or array element), or the description of a
 261    structure or union.
 262
 263    SHOW nonzero means don't print this type as just its name;
 264    show its real definition even if it has a name.
 265    SHOW zero means print just typename or struct tag if there is one
 266    SHOW negative means abbreviate structure elements.
 267    SHOW is decremented for printing of structure elements.
 268
 269    LEVEL is the depth to indent by.
 270    We increase it for some recursive calls.  */
 271
 272 void
 273 f_type_print_base (struct type *type, struct ui_file *stream, int show,
 274                    int level)
 275 {
 276   int upper_bound;
 277   int index;
 278
 279   QUIT;
 280
 281   wrap_here ("    ");
 282   if (type == NULL)
 283     {
 284       fputs_filtered ("<type unknown>", stream);
 285       return;
 286     }
 287
 288   /* When SHOW is zero or less, and there is a valid type name, then always
 289      just print the type name directly from the type.  */
 290
 291   if ((show <= 0) && (TYPE_NAME (type) != NULL))
 292     {
 293       const char *prefix = "";
 294       if (TYPE_CODE (type) == TYPE_CODE_UNION)
 295         prefix = "Type, C_Union :: ";
 296       else if (TYPE_CODE (type) == TYPE_CODE_STRUCT)
 297         prefix = "Type ";
 298       fprintfi_filtered (level, stream, "%s%s", prefix, TYPE_NAME (type));
 299       return;
 300     }
 301
 302   if (TYPE_CODE (type) != TYPE_CODE_TYPEDEF)
 303     type = check_typedef (type);
 304
 305   switch (TYPE_CODE (type))
 306     {
 307     case TYPE_CODE_TYPEDEF:
 308       f_type_print_base (TYPE_TARGET_TYPE (type), stream, 0, level);
 309       break;
 310
 311     case TYPE_CODE_ARRAY:
 312       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 313       break;
 314     case TYPE_CODE_FUNC:
 315       if (TYPE_TARGET_TYPE (type) == NULL)
 316         type_print_unknown_return_type (stream);
 317       else
 318         f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, level);
 319       break;
 320
 321     case TYPE_CODE_PTR:
 322       fprintfi_filtered (level, stream, "PTR TO -> ( ");
 323       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 324       break;
 325
 326     case TYPE_CODE_REF:
 327       fprintfi_filtered (level, stream, "REF TO -> ( ");
 328       f_type_print_base (TYPE_TARGET_TYPE (type), stream, show, 0);
 329       break;
 330
 331     case TYPE_CODE_VOID:
 332       fprintfi_filtered (level, stream, "VOID");
 333       break;
 334
 335     case TYPE_CODE_UNDEF:
 336       fprintfi_filtered (level, stream, "struct <unknown>");
 337       break;
 338
 339     case TYPE_CODE_ERROR:
 340       fprintfi_filtered (level, stream, "%s", TYPE_ERROR_NAME (type));
 341       break;
 342
 343     case TYPE_CODE_RANGE:
 344       /* This should not occur.  */
 345       fprintfi_filtered (level, stream, "<range type>");
 346       break;
 347
 348     case TYPE_CODE_CHAR:
 349     case TYPE_CODE_INT:
 350       /* There may be some character types that attempt to come
 351          through as TYPE_CODE_INT since dbxstclass.h is so
 352          C-oriented, we must change these to "character" from "char".  */
 353
 354       if (strcmp (TYPE_NAME (type), "char") == 0)
 355         fprintfi_filtered (level, stream, "character");
 356       else
 357         goto default_case;
 358       break;
 359
 360     case TYPE_CODE_STRING:
 361       /* Strings may have dynamic upperbounds (lengths) like arrays.  */
 362
 363       if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type))
 364         fprintfi_filtered (level, stream, "character*(*)");
 365       else
 366         {
 367           upper_bound = f77_get_upperbound (type);
 368           fprintf_filtered (stream, "character*%d", upper_bound);
 369         }
 370       break;
 371
 372     case TYPE_CODE_STRUCT:
 373     case TYPE_CODE_UNION:
 374       if (TYPE_CODE (type) == TYPE_CODE_UNION)
 375         fprintfi_filtered (level, stream, "Type, C_Union :: ");
 376       else
 377         fprintfi_filtered (level, stream, "Type ");
 378       fputs_filtered (TYPE_NAME (type), stream);
 379       /* According to the definition,
 380          we only print structure elements in case show > 0.  */
 381       if (show > 0)
 382         {
 383           fputs_filtered ("\n", stream);
 384           for (index = 0; index < TYPE_NFIELDS (type); index++)
 385             {
 386               f_type_print_base (TYPE_FIELD_TYPE (type, index), stream,
 387                                  show - 1, level + 4);
 388               fputs_filtered (" :: ", stream);
 389               fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
 390               f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
 391                                            stream, show - 1, 0, 0, 0);
 392               fputs_filtered ("\n", stream);
 393             }
 394           fprintfi_filtered (level, stream, "End Type ");
 395           fputs_filtered (TYPE_NAME (type), stream);
 396         }
 397       break;
 398
 399     case TYPE_CODE_MODULE:
 400       fprintfi_filtered (level, stream, "module %s", TYPE_NAME (type));
 401       break;
 402
 403     default_case:
 404     default:
 405       /* Handle types not explicitly handled by the other cases,
 406          such as fundamental types.  For these, just print whatever
 407          the type name is, as recorded in the type itself.  If there
 408          is no type name, then complain.  */
 409       if (TYPE_NAME (type) != NULL)
 410         fprintfi_filtered (level, stream, "%s", TYPE_NAME (type));
 411       else
 412         error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type));
 413       break;
 414     }
 415 }