[v3,3/6] Fortran: Ptype, print type extension.

Message ID 1502449611-8865-4-git-send-email-tim.wiederhake@intel.com
State New, archived
Headers

Commit Message

Wiederhake, Tim Aug. 11, 2017, 11:06 a.m. UTC
  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

Yao Qi Aug. 23, 2017, 11:05 a.m. UTC | #1
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.
  
Wiederhake, Tim Aug. 24, 2017, 12:36 p.m. UTC | #2
> -----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
  

Patch

diff --git a/gdb/f-typeprint.c b/gdb/f-typeprint.c
index 7dbe093..52beb1b 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -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)
diff --git a/gdb/testsuite/gdb.fortran/oop_extend_type.exp b/gdb/testsuite/gdb.fortran/oop_extend_type.exp
index 162a23b..c913387 100644
--- a/gdb/testsuite/gdb.fortran/oop_extend_type.exp
+++ b/gdb/testsuite/gdb.fortran/oop_extend_type.exp
@@ -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 $" {