diff options
| -rw-r--r-- | gdb/f-lang.h | 11 | ||||
| -rw-r--r-- | gdb/f-typeprint.c | 24 | ||||
| -rwxr-xr-x | gdb/testsuite/gdb.fortran/oop_extend_type.exp | 65 |
3 files changed, 81 insertions, 19 deletions
diff --git a/gdb/f-lang.h b/gdb/f-lang.h index 2a1f6c7..f92d3b0 100644 --- a/gdb/f-lang.h +++ b/gdb/f-lang.h @@ -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. diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 31786d4..170187c 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -285,6 +285,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) diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.exp b/gdb/testsuite/gdb.fortran/oop_extend_type.exp index eefc66c..00cfffa 100755 --- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -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 $" { |