[PATCH 2/2] gdb/fortran: print fortran extended types with ptype

[Nils-Christian Kempke <nils-christian.kempke@intel.com>]

From: Bernhard Heckel <bernhard.heckel@intel.com>

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>
---
 gdb/f-lang.h                                  | 11 ++++
 gdb/f-typeprint.c                             | 24 ++++++-
 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 26b2c09309..14ab8ce245 100644
--- a/gdb/f-lang.h
+++ b/gdb/f-lang.h
@@ -260,6 +260,17 @@ class f_language : public language_defn
 				    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 a633e47b2d..1761a38e94 100644
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -282,6 +282,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
+{
+  const int i = 0;  // Fortran doesn't support multiple inheritance.
+
+  if (TYPE_N_BASECLASSES (type) > 0)
+    fprintf_filtered (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
@@ -392,10 +405,17 @@ f_language::f_type_print_base (struct type *type, struct ui_file *stream,
     case TYPE_CODE_STRUCT:
     case TYPE_CODE_UNION:
       if (type->code () == TYPE_CODE_UNION)
-	fprintf_filtered (stream, "%*sType, C_Union :: ", level, "");
+	fprintf_filtered (stream, "%*sType, C_Union ::", level, "");
       else
-	fprintf_filtered (stream, "%*sType ", level, "");
+	fprintf_filtered (stream, "%*sType", level, "");
+
+      if (show > 0)
+	f_type_print_derivation_info (type, stream);
+
+      fputs_filtered (" ", stream);
+
       fputs_filtered (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 5d73e14a56..3b4e6cac3a 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 $" {
-- 
2.25.1

Intel Deutschland GmbH
Registered Address: Am Campeon 10, 85579 Neubiberg, Germany
Tel: +49 89 99 8853-0, www.intel.de <http://www.intel.de>
Managing Directors: Christin Eisenschmid, Sharon Heck, Tiffany Doon Silva  
Chairperson of the Supervisory Board: Nicole Lau
Registered Office: Munich
Commercial Register: Amtsgericht Muenchen HRB 186928