gdb/f-typeprint.c

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