gdb/f-typeprint.c

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