[v3,3/6] Fortran: Ptype, print type extension.
Commit Message
From: Bernhard Heckel <bernhard.heckel@intel.com>
Print base-class of an extended type when doing a ptype.
xxxx-yy-zz Bernhard Heckel <bernhard.heckel@intel.com>
gdb/ChangeLog:
* gdb/f-typeprint.c (f_type_print_derivation_info): New function.
(f_type_print_base): Print baseclass info.
gdb/testsuite/ChangeLog:
* gdb.fortran/oop_extend_type.exp: Adapt expected results.
---
gdb/f-typeprint.c | 28 ++++++++++++++++++++++---
gdb/testsuite/gdb.fortran/oop_extend_type.exp | 30 ++++++++++++++++++++-------
2 files changed, 48 insertions(+), 10 deletions(-)
Comments
Tim Wiederhake <tim.wiederhake@intel.com> writes:
> +gdb_test_multiple $test %test {
s/%test/$test
> + -re "$output_pass\r\n$gdb_prompt $" {
> + pass "$test"
> + }
> + -re "$output_xfail\r\n$gdb_prompt $" {
> + xfail "gcc/49475"
> + }
> +}
> set test "ptype wp%coo"
> gdb_test_multiple "$test" "$test" {
> -re "$real \\(3\\)\r\n$gdb_prompt $" {
> @@ -80,11 +92,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 {
Likewise.
Patch is good to me.
> -----Original Message-----
> From: gdb-patches-owner@sourceware.org [mailto:gdb-patches-
> owner@sourceware.org] On Behalf Of Yao Qi
> Sent: Wednesday, August 23, 2017 1:05 PM
> To: Wiederhake, Tim <tim.wiederhake@intel.com>
> Cc: gdb-patches@sourceware.org; Bernhard Heckel
> <bernhard.heckel@intel.com>
> Subject: Re: [PATCH v3 3/6] Fortran: Ptype, print type extension.
>
> Tim Wiederhake <tim.wiederhake@intel.com> writes:
>
> > +gdb_test_multiple $test %test {
>
> s/%test/$test
>
> > + -re "$output_pass\r\n$gdb_prompt $" {
> > + pass "$test"
> > + }
> > + -re "$output_xfail\r\n$gdb_prompt $" {
> > + xfail "gcc/49475"
> > + }
> > +}
> > set test "ptype wp%coo"
> > gdb_test_multiple "$test" "$test" {
> > -re "$real \\(3\\)\r\n$gdb_prompt $" {
> > @@ -80,11 +92,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 {
>
> Likewise.
Both applied locally.
> Patch is good to me.
Thanks!
Now #1 and #3 are OK'd;
#2, #4, #5, #6 still need review.
Regards,
Tim
>
> --
> Yao (齐尧)
Intel Deutschland GmbH
Registered Address: Am Campeon 10-12, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de
Managing Directors: Christin Eisenschmid, Christian Lamprechter
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928
@@ -256,6 +256,23 @@ 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)
+{
+ if (TYPE_N_BASECLASSES (type) > 0)
+ fprintf_filtered (stream, ", extends(%s) ::",
+ type_name_no_tag (TYPE_BASECLASS (type, 0)));
+}
+
/* Print the name of the type (or the ultimate pointer target,
function value or array element), or the description of a
structure or union.
@@ -362,10 +379,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)
@@ -50,11 +50,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_xfail [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_xfail\r\n$gdb_prompt $" {
+ xfail "gcc/49475"
+ }
+}
set test "ptype wp%coo"
gdb_test_multiple "$test" "$test" {
-re "$real \\(3\\)\r\n$gdb_prompt $" {
@@ -80,11 +92,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_xfail \\(3\\)\r\n$gdb_prompt $" {
+ xfail "gcc/49475"
+ }
+}
set test "ptype wp_vla(1)%coo"
gdb_test_multiple "$test" "$test" {
-re "$real \\(3\\)\r\n$gdb_prompt $" {