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