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