yggdrasil/binutils-gdb
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

gdb/fortran: print fortran extended types with ptype

Browse Source 
Add the print of the base-class of an extended type to the output of
ptype.  This requires the Fortran compiler to emit DW_AT_inheritance
for the extended type.

Co-authored-by: Nils-Christian Kempke <nils-christian.kempke@intel.com>
This commit is contained in:
Bernhard Heckel 2022-04-05 17:44:46 +02:00 committed by Nils-Christian Kempke
parent 87e10e9c28
commit 110aae55a8
3 changed files with 80 additions and 18 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
gdb/f-lang.h
View File

@ -266,6 +266,17 @@ private:
int arrayprint_recurse_level,
bool print_rank_only) const;
/* If TYPE is an extended type, then print out derivation information.
A typical output could look like this:
"Type, extends(point) :: waypoint"
" Type point :: point"
" real(kind=4) :: angle"
"End Type waypoint". */
void f_type_print_derivation_info (struct type *type,
struct ui_file *stream) const;
/* Print the name of the type (or the ultimate pointer target, function
value or array element), or the description of a structure or union.

24
gdb/f-typeprint.c
View File

@ -284,6 +284,19 @@ f_language::f_type_print_varspec_suffix (struct type *type,
/* See f-lang.h. */
void
f_language::f_type_print_derivation_info (struct type *type,
struct ui_file *stream) const
{
/* Fortran doesn't support multiple inheritance. */
const int i = 0;
if (TYPE_N_BASECLASSES (type) > 0)
gdb_printf (stream, ", extends(%s) ::", TYPE_BASECLASS (type, i)->name ());
}
/* See f-lang.h. */
void
f_language::f_type_print_base (struct type *type, struct ui_file *stream,
int show, int level) const
@ -396,10 +409,17 @@ f_language::f_type_print_base (struct type *type, struct ui_file *stream,
case TYPE_CODE_UNION:
case TYPE_CODE_NAMELIST:
if (type->code () == TYPE_CODE_UNION)
gdb_printf (stream, "%*sType, C_Union :: ", level, "");
gdb_printf (stream, "%*sType, C_Union ::", level, "");
else
gdb_printf (stream, "%*sType ", level, "");
gdb_printf (stream, "%*sType", level, "");
if (show > 0)
f_type_print_derivation_info (type, stream);
gdb_puts (" ", stream);
gdb_puts (type->name (), stream);
/* According to the definition,
we only print structure elements in case show > 0. */
if (show > 0)

63
gdb/testsuite/gdb.fortran/oop_extend_type.exp
View File

@ -60,12 +60,24 @@ gdb_test "p wp%point" " = \\( coo = \\(1, 2, 1\\) \\)"
gdb_test "p wp" " = \\( point = \\( coo = \\(1, 2, 1\\) \\), angle = 100 \\)"
gdb_test "whatis wp" "type = Type waypoint"
gdb_test "ptype wp" \
[multi_line "type = Type waypoint" \
" Type point :: point" \
" $real :: angle" \
"End Type waypoint"]
set output_pass_wp [multi_line "type = Type, extends\\(point\\) :: waypoint" \
" Type point :: point" \
" $real :: angle" \
"End Type waypoint(, allocatable)?"]
set output_kfail_wp [multi_line "type = Type waypoint" \
" Type point :: point" \
" $real :: angle" \
"End Type waypoint(, allocatable)?"]
set test "ptype wp"
gdb_test_multiple "$test" "$test" {
-re "$output_pass_wp\r\n$gdb_prompt $" {
pass "$test"
}
-re "$output_kfail_wp\r\n$gdb_prompt $" {
kfail "gcc/49475" "$test"
}
}
set test "ptype wp%coo"
gdb_test_multiple "$test" "$test" {
-re "$real \\(3\\)\r\n$gdb_prompt $" {
@ -105,11 +117,27 @@ gdb_test_multiple "$test" "$test" {
}
gdb_test "whatis fwp" "type = Type fancywaypoint"
gdb_test "ptype fwp" \
[multi_line "type = Type fancywaypoint" \
" Type waypoint :: waypoint" \
" $logical :: is_fancy" \
"End Type fancywaypoint"]
set test "ptype fwp"
set output_pass_fwp \
[multi_line "type = Type, extends\\(waypoint\\) :: fancywaypoint" \
" Type waypoint :: waypoint" \
" $logical :: is_fancy" \
"End Type fancywaypoint"]
set output_kfail_fwp \
[multi_line "type = Type fancywaypoint" \
" Type waypoint :: waypoint" \
" $logical :: is_fancy" \
"End Type fancywaypoint"]
gdb_test_multiple "$test" "$test" {
-re "$output_pass_fwp\r\n$gdb_prompt $" {
pass "$test"
}
-re "$output_kfail_fwp\r\n$gdb_prompt $" {
kfail "gcc/49475" "$test"
}
}
set test "ptype fwp%coo"
gdb_test_multiple "$test" "$test" {
@ -140,12 +168,15 @@ gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 1
gdb_test "whatis wp_vla" "type = Type waypoint, allocatable \\(3\\)" \
"whatis wp_vla after allocation"
gdb_test "ptype wp_vla" \
[multi_line "type = Type waypoint" \
" Type point :: point" \
" $real :: angle" \
"End Type waypoint, allocatable \\(3\\)"]
set test "ptype wp_vla"
gdb_test_multiple "$test" "$test" {
-re "$output_pass_wp \\(3\\)\r\n$gdb_prompt $" {
pass "$test"
}
-re "$output_kfail_wp \\(3\\)\r\n$gdb_prompt $" {
kfail "gcc/49475" "$test"
}
}
set test "ptype wp_vla(1)%coo"
gdb_test_multiple "$test" "$test" {
-re "$real \\(3\\)\r\n$gdb_prompt $" {