gdb/fortran: print fortran extended types with ptype

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>

diff --git a/gdb/f-lang.h b/gdb/f-lang.h
index 2a1f6c7e737ead89ee0c05fe8fbe18108021673f..f92d3b01c78b8cec2ba5c5c26d615c280d4a5134 100644 (file)
--- 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 31786d4ea189dbb7d55e81c085641eda8a7821a3..170187c6749415f2ad8d1eb958f3e85f498674eb 100644 (file)
--- a/gdb/f-typeprint.c
+++ b/gdb/f-typeprint.c
@@ -284,6 +284,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 eefc66c95142b00d3281e7870b77dab29efecc43..00cfffa0b63232b666cd0ee2c591e356dd4aede4 100755 (executable)
--- 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 $" {