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