diff options
| author | Bernhard Heckel <bernhard.heckel@intel.com> | 2016-05-24 09:20:34 +0200 |
|---|---|---|
| committer | Bernhard Heckel <bernhard.heckel@intel.com> | 2016-12-23 12:25:46 +0100 |
| commit | 86a3a302bcaf2af901aed505c3ee5e8935b948f8 (patch) | |
| tree | 0d15e3ed310ea84ea4489c602917f1e53e0c2e9e | |
| parent | 7fc0b1909263c0217ba70a693f93a57271a80465 (diff) | |
| download | binutils-gdb-users/bheckel/fortran-oop-extend-type.tar.gz | |
Fortran: Ptype, print type extension.users/bheckel/fortran-oop-extend-type
Print base-class of an extended type when doing a ptype.
2016-05-24 Bernhard Heckel <bernhard.heckel@intel.com>
gdb/Changelog:
* gdb/f-typeprint.c (f_type_print_derivation_info): New.
(f_type_print_base): Print baseclass info.
gdb/Testsuite/Changelog:
* gdb.fortran/oop_extend_type.exp: Adapt expected results.
Change-Id: I95e91357137a7b5aa178ffd7bb6839feb6b436bb
| -rw-r--r-- | gdb/f-typeprint.c | 29 | ||||
| -rwxr-xr-x | gdb/testsuite/gdb.fortran/oop_extend_type.exp | 30 |
2 files changed, 49 insertions, 10 deletions
diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c index 920c21fbcf0..06919eecd96 100644 --- a/gdb/f-typeprint.c +++ b/gdb/f-typeprint.c @@ -254,6 +254,24 @@ f_type_print_varspec_suffix (struct type *type, struct ui_file *stream, } } +/* 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" + */ + +static void +f_type_print_derivation_info (struct type *type, struct ui_file *stream) +{ + int i = 0; // Fortran doesn't support multiple inheritance. + + if (TYPE_N_BASECLASSES (type) > 0) + fprintf_filtered (stream, ", extends(%s) ::", type_name_no_tag (TYPE_BASECLASS (type, i))); +} + /* Print the name of the type (or the ultimate pointer target, function value or array element), or the description of a structure or union. @@ -360,10 +378,15 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show, case TYPE_CODE_STRUCT: case TYPE_CODE_UNION: if (TYPE_CODE (type) == TYPE_CODE_UNION) - fprintfi_filtered (level, stream, "Type, C_Union :: "); + fprintfi_filtered (level, stream, "Type, C_Union ::"); else - fprintfi_filtered (level, stream, "Type "); - fputs_filtered (TYPE_TAG_NAME (type), stream); + fprintfi_filtered (level, stream, "Type"); + + if (show > 0) + f_type_print_derivation_info (type, stream); + + fprintf_filtered (stream, " %s", TYPE_TAG_NAME (type)); + /* 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 ca273198ddc..6c4867c09a0 100755 --- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp +++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp @@ -49,11 +49,23 @@ 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" \
+set output_pass [multi_line "type = Type, extends\\(point\\) :: waypoint" \
" Type point :: point" \
" $real :: angle" \
"End Type waypoint"]
+set output_kfail [multi_line "type = Type waypoint" \
+ " Type point :: point" \
+ " $real :: angle" \
+ "End Type waypoint"]
+set test "ptype wp"
+gdb_test_multiple $test %test {
+ -re "$output_pass\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "$output_kfail\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 $" {
@@ -79,11 +91,15 @@ gdb_test "p wp_vla(1)%point" " = \\( coo = \\(10, 12, 10\\) \\)" gdb_test "p wp_vla(1)" " = \\( point = \\( coo = \\(10, 12, 10\\) \\), angle = 101 \\)"
gdb_test "whatis wp_vla" "type = Type waypoint \\(3\\)"
-gdb_test "ptype wp_vla" \
- [multi_line "type = Type waypoint" \
- " Type point :: point" \
- " $real :: angle" \
- "End Type waypoint \\(3\\)"]
+set test "ptype wp_vla"
+gdb_test_multiple $test %test {
+ -re "$output_pass \\(3\\)\r\n$gdb_prompt $" {
+ pass "$test"
+ }
+ -re "$output_kfail \\(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 $" {
|