]>
git.ipfire.org Git - thirdparty/binutils-gdb.git/blob - gdb/f-typeprint.c
1 /* Support for printing Fortran types for GDB, the GNU debugger.
3 Copyright (C) 1986-2019 Free Software Foundation, Inc.
5 Contributed by Motorola. Adapted from the C version by Farooq Butt
6 (fmbutt@engage.sps.mot.com).
8 This file is part of GDB.
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.
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.
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/>. */
24 #include "gdb_obstack.h"
28 #include "expression.h"
33 #include "typeprint.h"
34 #include "cli/cli-style.h"
36 #if 0 /* Currently unused. */
37 static void f_type_print_args (struct type
*, struct ui_file
*);
40 static void f_type_print_varspec_suffix (struct type
*, struct ui_file
*, int,
43 void f_type_print_varspec_prefix (struct type
*, struct ui_file
*,
46 void f_type_print_base (struct type
*, struct ui_file
*, int, int);
49 /* See documentation in f-lang.h. */
52 f_print_typedef (struct type
*type
, struct symbol
*new_symbol
,
53 struct ui_file
*stream
)
55 type
= check_typedef (type
);
56 f_print_type (type
, "", stream
, 0, 0, &type_print_raw_options
);
57 fprintf_filtered (stream
, "\n");
60 /* LEVEL is the depth to indent lines by. */
63 f_print_type (struct type
*type
, const char *varstring
, struct ui_file
*stream
,
64 int show
, int level
, const struct type_print_options
*flags
)
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. */
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
))
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);
88 if (varstring
!= NULL
)
92 fputs_filtered (varstring
, stream
);
94 /* For demangled function names, we have the arglist as part of the name,
95 so don't print an additional pair of ()'s. */
97 demangled_args
= (*varstring
!= '\0'
98 && varstring
[strlen (varstring
) - 1] == ')');
99 f_type_print_varspec_suffix (type
, stream
, show
, 0, demangled_args
, 0, false);
103 /* Print any asterisks or open-parentheses needed before the
104 variable name (to describe its type).
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. */
112 f_type_print_varspec_prefix (struct type
*type
, struct ui_file
*stream
,
113 int show
, int passed_a_ptr
)
118 if (TYPE_NAME (type
) && show
<= 0)
123 switch (TYPE_CODE (type
))
126 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 1);
130 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
132 fprintf_filtered (stream
, "(");
135 case TYPE_CODE_ARRAY
:
136 f_type_print_varspec_prefix (TYPE_TARGET_TYPE (type
), stream
, 0, 0);
139 case TYPE_CODE_UNDEF
:
140 case TYPE_CODE_STRUCT
:
141 case TYPE_CODE_UNION
:
146 case TYPE_CODE_ERROR
:
150 case TYPE_CODE_RANGE
:
151 case TYPE_CODE_STRING
:
152 case TYPE_CODE_METHOD
:
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. */
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.
166 PRINT_RANK_ONLY is true when TYPE is an array which should be printed
167 without the upper and lower bounds being specified, this will occur
168 when the array is not allocated or not associated and so there are no
169 known upper or lower bounds. */
172 f_type_print_varspec_suffix (struct type
*type
, struct ui_file
*stream
,
173 int show
, int passed_a_ptr
, int demangled_args
,
174 int arrayprint_recurse_level
, bool print_rank_only
)
176 /* No static variables are permitted as an error call may occur during
177 execution of this function. */
182 if (TYPE_NAME (type
) && show
<= 0)
187 switch (TYPE_CODE (type
))
189 case TYPE_CODE_ARRAY
:
190 arrayprint_recurse_level
++;
192 if (arrayprint_recurse_level
== 1)
193 fprintf_filtered (stream
, "(");
195 if (type_not_associated (type
))
196 print_rank_only
= true;
197 else if (type_not_allocated (type
))
198 print_rank_only
= true;
199 else if ((TYPE_ASSOCIATED_PROP (type
)
200 && PROP_CONST
!= TYPE_DYN_PROP_KIND (TYPE_ASSOCIATED_PROP (type
)))
201 || (TYPE_ALLOCATED_PROP (type
)
202 && PROP_CONST
!= TYPE_DYN_PROP_KIND (TYPE_ALLOCATED_PROP (type
)))
203 || (TYPE_DATA_LOCATION (type
)
204 && PROP_CONST
!= TYPE_DYN_PROP_KIND (TYPE_DATA_LOCATION (type
))))
206 /* This case exist when we ptype a typename which has the dynamic
207 properties but cannot be resolved as there is no object. */
208 print_rank_only
= true;
211 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) == TYPE_CODE_ARRAY
)
212 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
213 0, 0, arrayprint_recurse_level
,
217 fprintf_filtered (stream
, ":");
220 LONGEST lower_bound
= f77_get_lowerbound (type
);
221 if (lower_bound
!= 1) /* Not the default. */
222 fprintf_filtered (stream
, "%s:", plongest (lower_bound
));
224 /* Make sure that, if we have an assumed size array, we
225 print out a warning and print the upperbound as '*'. */
227 if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
228 fprintf_filtered (stream
, "*");
231 LONGEST upper_bound
= f77_get_upperbound (type
);
233 fputs_filtered (plongest (upper_bound
), stream
);
237 if (TYPE_CODE (TYPE_TARGET_TYPE (type
)) != TYPE_CODE_ARRAY
)
238 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
239 0, 0, arrayprint_recurse_level
,
242 if (arrayprint_recurse_level
== 1)
243 fprintf_filtered (stream
, ")");
245 fprintf_filtered (stream
, ",");
246 arrayprint_recurse_level
--;
251 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0, 1, 0,
252 arrayprint_recurse_level
, false);
253 fprintf_filtered (stream
, " )");
258 int i
, nfields
= TYPE_NFIELDS (type
);
260 f_type_print_varspec_suffix (TYPE_TARGET_TYPE (type
), stream
, 0,
262 arrayprint_recurse_level
, false);
264 fprintf_filtered (stream
, ") ");
265 fprintf_filtered (stream
, "(");
266 if (nfields
== 0 && TYPE_PROTOTYPED (type
))
267 f_print_type (builtin_f_type (get_type_arch (type
))->builtin_void
,
268 "", stream
, -1, 0, 0);
270 for (i
= 0; i
< nfields
; i
++)
274 fputs_filtered (", ", stream
);
277 f_print_type (TYPE_FIELD_TYPE (type
, i
), "", stream
, -1, 0, 0);
279 fprintf_filtered (stream
, ")");
283 case TYPE_CODE_UNDEF
:
284 case TYPE_CODE_STRUCT
:
285 case TYPE_CODE_UNION
:
290 case TYPE_CODE_ERROR
:
294 case TYPE_CODE_RANGE
:
295 case TYPE_CODE_STRING
:
296 case TYPE_CODE_METHOD
:
297 case TYPE_CODE_COMPLEX
:
298 case TYPE_CODE_TYPEDEF
:
299 /* These types do not need a suffix. They are listed so that
300 gcc -Wall will report types that may not have been considered. */
305 /* Print the name of the type (or the ultimate pointer target,
306 function value or array element), or the description of a
309 SHOW nonzero means don't print this type as just its name;
310 show its real definition even if it has a name.
311 SHOW zero means print just typename or struct tag if there is one
312 SHOW negative means abbreviate structure elements.
313 SHOW is decremented for printing of structure elements.
315 LEVEL is the depth to indent by.
316 We increase it for some recursive calls. */
319 f_type_print_base (struct type
*type
, struct ui_file
*stream
, int show
,
329 fputs_styled ("<type unknown>", metadata_style
.style (), stream
);
333 /* When SHOW is zero or less, and there is a valid type name, then always
334 just print the type name directly from the type. */
336 if ((show
<= 0) && (TYPE_NAME (type
) != NULL
))
338 const char *prefix
= "";
339 if (TYPE_CODE (type
) == TYPE_CODE_UNION
)
340 prefix
= "Type, C_Union :: ";
341 else if (TYPE_CODE (type
) == TYPE_CODE_STRUCT
)
343 fprintfi_filtered (level
, stream
, "%s%s", prefix
, TYPE_NAME (type
));
347 if (TYPE_CODE (type
) != TYPE_CODE_TYPEDEF
)
348 type
= check_typedef (type
);
350 switch (TYPE_CODE (type
))
352 case TYPE_CODE_TYPEDEF
:
353 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, 0, level
);
356 case TYPE_CODE_ARRAY
:
357 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
360 if (TYPE_TARGET_TYPE (type
) == NULL
)
361 type_print_unknown_return_type (stream
);
363 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, level
);
367 fprintfi_filtered (level
, stream
, "PTR TO -> ( ");
368 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
372 fprintfi_filtered (level
, stream
, "REF TO -> ( ");
373 f_type_print_base (TYPE_TARGET_TYPE (type
), stream
, show
, 0);
378 gdbarch
*gdbarch
= get_type_arch (type
);
379 struct type
*void_type
= builtin_f_type (gdbarch
)->builtin_void
;
380 fprintfi_filtered (level
, stream
, "%s", TYPE_NAME (void_type
));
384 case TYPE_CODE_UNDEF
:
385 fprintfi_filtered (level
, stream
, "struct <unknown>");
388 case TYPE_CODE_ERROR
:
389 fprintfi_filtered (level
, stream
, "%s", TYPE_ERROR_NAME (type
));
392 case TYPE_CODE_RANGE
:
393 /* This should not occur. */
394 fprintfi_filtered (level
, stream
, "<range type>");
399 /* There may be some character types that attempt to come
400 through as TYPE_CODE_INT since dbxstclass.h is so
401 C-oriented, we must change these to "character" from "char". */
403 if (strcmp (TYPE_NAME (type
), "char") == 0)
404 fprintfi_filtered (level
, stream
, "character");
409 case TYPE_CODE_STRING
:
410 /* Strings may have dynamic upperbounds (lengths) like arrays. */
412 if (TYPE_ARRAY_UPPER_BOUND_IS_UNDEFINED (type
))
413 fprintfi_filtered (level
, stream
, "character*(*)");
416 LONGEST upper_bound
= f77_get_upperbound (type
);
418 fprintf_filtered (stream
, "character*%s", pulongest (upper_bound
));
422 case TYPE_CODE_STRUCT
:
423 case TYPE_CODE_UNION
:
424 if (TYPE_CODE (type
) == TYPE_CODE_UNION
)
425 fprintfi_filtered (level
, stream
, "Type, C_Union :: ");
427 fprintfi_filtered (level
, stream
, "Type ");
428 fputs_filtered (TYPE_NAME (type
), stream
);
429 /* According to the definition,
430 we only print structure elements in case show > 0. */
433 fputs_filtered ("\n", stream
);
434 for (index
= 0; index
< TYPE_NFIELDS (type
); index
++)
436 f_type_print_base (TYPE_FIELD_TYPE (type
, index
), stream
,
437 show
- 1, level
+ 4);
438 fputs_filtered (" :: ", stream
);
439 fputs_filtered (TYPE_FIELD_NAME (type
, index
), stream
);
440 f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type
, index
),
441 stream
, show
- 1, 0, 0, 0, false);
442 fputs_filtered ("\n", stream
);
444 fprintfi_filtered (level
, stream
, "End Type ");
445 fputs_filtered (TYPE_NAME (type
), stream
);
449 case TYPE_CODE_MODULE
:
450 fprintfi_filtered (level
, stream
, "module %s", TYPE_NAME (type
));
455 /* Handle types not explicitly handled by the other cases,
456 such as fundamental types. For these, just print whatever
457 the type name is, as recorded in the type itself. If there
458 is no type name, then complain. */
459 if (TYPE_NAME (type
) != NULL
)
460 fprintfi_filtered (level
, stream
, "%s", TYPE_NAME (type
));
462 error (_("Invalid type code (%d) in symbol table."), TYPE_CODE (type
));
466 if (TYPE_IS_ALLOCATABLE (type
))
467 fprintf_filtered (stream
, ", allocatable");