Fortran, typeprint: Decrease level of details when printing elements of a structure.
authorBernhard Heckel <bernhard.heckel@intel.com>
Wed, 25 May 2016 06:47:17 +0000 (08:47 +0200)
committerBernhard Heckel <bernhard.heckel@intel.com>
Wed, 25 May 2016 06:47:17 +0000 (08:47 +0200)
According to the typeprint's description, the level of details is
decreased by one for the typeprint of elements of a structure.

Before:
(gdb) ptype t3v
type = Type t3
    integer(kind=4) :: t3_i
    Type t2
        integer(kind=4) :: t2_i
        Type t1
            integer(kind=4) :: t1_i
            real(kind=4) :: t1_r
        End Type t1 :: t1_n
    End Type t2 :: t2_n
End Type t3

After:
(gdb) ptype t3v
type = Type t3
    integer(kind=4) :: t3_i
    Type t2 :: t2_n
End Type t3

2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>

gdb/Changelog:
* f-typeprint.c (f_type_print_base): Decrease show by one.

gdb/testsuite/Changelog:
* gdb.fortran/type.f90: Add nested structures.
* gdb.fortran/whatis-type.exp: Whatis/ptype nested structures.
* gdb.fortran/derived-type.exp: Adapt expected output.
* gdb.fortran/vla-type.exp: Adapt expected output.

gdb/ChangeLog
gdb/f-typeprint.c
gdb/testsuite/ChangeLog
gdb/testsuite/gdb.fortran/derived-type.exp
gdb/testsuite/gdb.fortran/type.f90
gdb/testsuite/gdb.fortran/vla-type.exp
gdb/testsuite/gdb.fortran/whatis_type.exp

index a4989dd..0328072 100644 (file)
@@ -1,5 +1,9 @@
 2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
 
+       * f-typeprint.c (f_type_print_base): Decrease show by one.
+
+2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
+
        * f-typeprint.c (f_type_print_base): Don't print fields when show < 0.
 
 2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
index f38a3a0..350def0 100644 (file)
@@ -371,12 +371,12 @@ f_type_print_base (struct type *type, struct ui_file *stream, int show,
          fputs_filtered ("\n", stream);
          for (index = 0; index < TYPE_NFIELDS (type); index++)
            {
-             f_type_print_base (TYPE_FIELD_TYPE (type, index), stream, show,
-                                level + 4);
+             f_type_print_base (TYPE_FIELD_TYPE (type, index), stream,
+                                show - 1, level + 4);
              fputs_filtered (" :: ", stream);
              fputs_filtered (TYPE_FIELD_NAME (type, index), stream);
              f_type_print_varspec_suffix (TYPE_FIELD_TYPE (type, index),
-                                          stream, 0, 0, 0, 0);
+                                          stream, show - 1, 0, 0, 0);
              fputs_filtered ("\n", stream);
            }
          fprintfi_filtered (level, stream, "End Type ");
index 712ee2f..c8f6ceb 100644 (file)
@@ -1,5 +1,12 @@
 2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
 
+       * gdb.fortran/type.f90: Add nested structures.
+       * gdb.fortran/whatis-type.exp: Whatis/ptype nested structures.
+       * gdb.fortran/derived-type.exp: Adapt expected output.
+       * gdb.fortran/vla-type.exp: Adapt expected output.
+
+2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
+
        * gdb.fortran/whatis_type.exp: Adapt expected output.
 
 2016-05-25  Bernhard Heckel  <bernhard.heckel@intel.com>
index 017c6b1..73eb1f4 100644 (file)
@@ -40,10 +40,10 @@ gdb_test "ptype p" "type = Type bar\r\n *$int :: c\r\n *$real :: d\r\n *End Type
 
 set test "type-printing for derived type"
 gdb_test_multiple "ptype q" $test {
-    -re "type = Type foo\r\n *$real :: a\r\n *Type bar\r\n *$int :: c\r\n *$real :: d\r\n *End Type bar :: x\r\n *character\\*7 :: b\r\n *End Type foo\r\n$gdb_prompt $" {
+    -re "type = Type foo\r\n *$real :: a\r\n *Type bar :: x\r\n *character\\*7 :: b\r\n *End Type foo\r\n$gdb_prompt $" {
        pass $test
     }
-    -re "type = Type foo\r\n *$real :: a\r\n *Type bar\r\n *$int :: c\r\n *$real :: d\r\n *End Type bar :: x\r\n *character :: b\\(7\\)\r\n *End Type foo\r\n$gdb_prompt $" {
+    -re "type = Type foo\r\n *$real :: a\r\n *Type bar :: x\r\n *character :: b\\(7\\)\r\n *End Type foo\r\n$gdb_prompt $" {
        # Compiler should produce string, not an array of characters.
        setup_xfail "*-*-*"
        fail $test
index b3ae693..00dc650 100644 (file)
@@ -21,8 +21,27 @@ program type
     real    :: t1_r
   end type t1
 
+  type :: t2
+    integer :: t2_i
+    type (t1) :: t1_n
+  end type t2
+
+  type :: t3
+    integer :: t3_i
+    type (t2) :: t2_n
+  end type t3
+
   type (t1) :: t1v
+  type (t2) :: t2v
+  type (t3) :: t3v
 
   t1v%t1_i = 42
-  t1v%t1_r = 42.24    ! bp1
+  t1v%t1_r = 42.24
+
+  t2v%t2_i = 2
+  t2v%t1_n%t1_i = 21
+  t3v%t3_i = 3
+  t3v%t2_n%t2_i = 32
+  t3v%t2_n%t1_n%t1_i = 321    ! bp1
+
 end program type
index 23c287f..e1a5db1 100755 (executable)
@@ -99,9 +99,7 @@ gdb_test "print fivev%tone%ivla(1, 2, 3)" " = 123"
 gdb_test "print fivev%tone%ivla(3, 2, 1)" " = 321"
 gdb_test "ptype fivev" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(10,10,10\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
 
 # Check array of types containing a VLA
@@ -114,15 +112,11 @@ gdb_test "print fivearr(2)%tone%ivla(12, 14, 16)" " = 2"
 gdb_test "print fivearr(2)%tone%ivla(6, 7, 8)" " = 678"
 gdb_test "ptype fivearr(1)" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(2,4,6\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
 gdb_test "ptype fivearr(2)" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(12,14,16\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
 
 # Check allocation status of dynamic array and it's dynamic members
@@ -130,9 +124,7 @@ gdb_test "ptype fivedynarr" "type = <not allocated>"
 gdb_test "next" ""
 gdb_test "ptype fivedynarr(2)" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(<not allocated>\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
 
 # Check dynamic array of types containing a VLA
@@ -145,13 +137,9 @@ gdb_test "print fivedynarr(2)%tone%ivla(12, 14, 16)" " = 2"
 gdb_test "print fivedynarr(2)%tone%ivla(6, 7, 8)" " = 678"
 gdb_test "ptype fivedynarr(1)" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(2,4,6\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
 gdb_test "ptype fivedynarr(2)" \
          [multi_line "type = Type five" \
-                     "\\s+Type one" \
-                     "\\s+$int :: ivla\\\(12,14,16\\\)" \
-                     "\\s+End Type one :: tone" \
+                     "\\s+Type one :: tone" \
                      "End Type five" ]
index 0b7a1b7..955f853 100644 (file)
@@ -40,6 +40,10 @@ set t1_r "$real :: t1_r"
 
 gdb_test "whatis t1" "type = Type t1"
 gdb_test "whatis t1v" "type = Type t1"
+gdb_test "whatis t2" "type = Type t2"
+gdb_test "whatis t2v" "type = Type t2"
+gdb_test "whatis t3" "type = Type t3"
+gdb_test "whatis t3v" "type = Type t3"
 
 gdb_test "ptype t1" \
   [multi_line "type = Type t1" \
@@ -53,3 +57,15 @@ gdb_test "ptype t1v" \
                  "    $t1_r" \
                  "End Type t1"] \
   "ptype t1v"
+
+gdb_test "ptype t2v" \
+  [multi_line "type = Type t2" \
+              "    $int :: t2_i" \
+              "    Type t1 :: t1_n" \
+              "End Type t2"]
+
+gdb_test "ptype t3v" \
+  [multi_line "type = Type t3" \
+              "    $int :: t3_i" \
+              "    Type t2 :: t2_n" \
+              "End Type t3"]