Commit: 04d59df6f311bcc20d74ada64a5e15a4bbb40026 - binutils_os216 (git)

GNU Binutils with patches for OS216

Commit MetaInfo

• Revision: 04d59df6f311bcc20d74ada64a5e15a4bbb40026 (tree)
• Time: 2016-06-21 22:15:04
• Author: Walfred Tedeschi <walfred.tedeschi@inte...>
• Commiter: Walfred Tedeschi

Log Message

Improve user experience in printing Fortran derived types.

Output for Fortran derived classes is like:

"( 9, 'abc')"

with this changes the output is changed to:

"( lucky_number = 9, letters = 'abc')"

2016-06-21 Walfred Tedeschi <[e-mail]>

* f-valprint.c (f_val_print): Add field names for printing
derived types fields.

gdb/testsuite:

* gdb.fortran/derived-type.exp (print q): Add fields to the output.
* gdb.fortran/vla-type.exp (print twov): Fix vla tests with
structs.
* gdb.fortran/derived-type-function.exp: New file.
* gdb.fortran/derived-type-function.f90: New file.

Change Summary

• modified: gdb/ChangeLog
• modified: gdb/f-valprint.c
• modified: gdb/testsuite/ChangeLog
• add: gdb/testsuite/gdb.fortran/derived-type-function.exp
• add: gdb/testsuite/gdb.fortran/derived-type-function.f90
• modified: gdb/testsuite/gdb.fortran/derived-type.exp
• modified: gdb/testsuite/gdb.fortran/vla-type.exp

Incremental Difference

--- a/gdb/ChangeLog
+++ b/gdb/ChangeLog
@@ -1,3 +1,8 @@
[phone]  Walfred Tedeschi  <[e-mail]>
+
+	* f-valprint.c (f_val_print): Add field names for printing
+	derived types fields.
+
 2016-06-21  Andreas Arnez  <[e-mail]>
 
 	* s390-linux-tdep.c (s390_iterate_over_regset_sections): Fix typo

--- a/gdb/f-valprint.c
+++ b/gdb/f-valprint.c
@@ -219,6 +219,7 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
   struct gdbarch *gdbarch = get_type_arch (type);
   enum bfd_endian byte_order = gdbarch_byte_order (gdbarch);
   unsigned int i = 0;	/* Number of characters printed.  */
+  int printed_field = 0; /* Number of fields printed.  */
   struct type *elttype;
   CORE_ADDR addr;
   int index;
@@ -337,15 +338,32 @@ f_val_print (struct type *type, const gdb_byte *valaddr, int embedded_offset,
 	  struct value *field = value_field
 	    ((struct value *)original_value, index);
 
-          val_print (value_type (field),
-		     value_contents_for_printing (field),
-		     value_embedded_offset (field),
-		     value_address (field), stream, recurse + 1,
-		     field, options, current_language);
+	  struct type *field_type = check_typedef (TYPE_FIELD_TYPE (type, index));
 
-          if (index != TYPE_NFIELDS (type) - 1)
-            fputs_filtered (", ", stream);
-        }
+
+	  if (TYPE_CODE (field_type) != TYPE_CODE_FUNC)
+	    {
+	      const char *field_name;
+
+	      if (printed_field > 0)
+		fputs_filtered (", ", stream);
+
+	      field_name = TYPE_FIELD_NAME (type, index);
+	      if (field_name != NULL)
+		{
+		  fputs_filtered (field_name, stream);
+		  fputs_filtered (" = ", stream);
+		}
+
+	      val_print (value_type (field),
+			 value_contents_for_printing (field),
+			 value_embedded_offset (field),
+			 value_address (field), stream, recurse + 1,
+			 field, options, current_language);
+
+	      ++printed_field;
+	    }
+	 }
       fprintf_filtered (stream, " )");
       break;     
 

--- a/gdb/testsuite/ChangeLog
+++ b/gdb/testsuite/ChangeLog
@@ -1,3 +1,12 @@
[phone]  Walfred Tedeschi  <[e-mail]>
+
+	* gdb.fortran/derived-type.exp (print q): Add fields to the output.
+	* gdb.fortran/vla-type.exp (print twov): Fix vla tests with
+	structs.
+	* gdb.fortran/derived-type-function.exp: New file.
+	* gdb.fortran/derived-type-function.f90: New file.
+
+
 2016-06-21  Pedro Alves  <[e-mail]>
 
 	* gdb.base/new-ui.exp: New file.

--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-function.exp
@@ -0,0 +1,38 @@
+# Copyright 2016 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file was contributed by Walfred Tedeschi ([e-mail]).
+
+# This file is part of the gdb testsuite.  It contains tests for type-printing
+# and value-printing Fortran derived types having also functions.
+
+if { [skip_fortran_tests] } { return -1 }
+
+standard_testfile .f90
+
+if {[prepare_for_testing $testfile.exp $testfile $srcfile {debug f90}]} {
+    return -1
+}
+
+if ![runto MAIN__] then {
+    perror "couldn't run to breakpoint MAIN__"
+    continue
+}
+
+gdb_breakpoint [gdb_get_line_number "bp"]
+gdb_continue_to_breakpoint "bp"
+
+gdb_test "print aRec" "= \\( a = 2, b = 3 \\)"\
+"Print rectangle structure with members' name"

--- /dev/null
+++ b/gdb/testsuite/gdb.fortran/derived-type-function.f90
@@ -0,0 +1,62 @@
+! Copyright 2016 Free Software Foundation, Inc.
+!
+! This program is free software; you can redistribute it and/or modify
+! it under the terms of the GNU General Public License as published by
+! the Free Software Foundation; either version 3 of the License, or
+! (at your option) any later version.
+!
+! This program is distributed in the hope that it will be useful,
+! but WITHOUT ANY WARRANTY; without even the implied warranty of
+! MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+! GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License
+! along with this program.  If not, see <http://www.gnu.org/licenses/>.
+!
+! This file is the Fortran source file for derived-type-function.exp.
+! It was contributed by Walfred Tedeschi ([e-mail]).
+
+module class_Rectangle
+  implicit none
+  private
+
+  type, public :: Rectangle
+     real :: a
+     real :: b
+   contains
+     procedure :: area => rectangle_area
+     procedure :: print_area => print_area
+  end type Rectangle
+contains
+
+  function rectangle_area (this) result (area)
+    class (Rectangle), intent (in) :: this
+
+    real :: area
+    area = this%a * this%b
+  end function rectangle_area
+
+  subroutine print_area (this)
+    class (Rectangle), intent (in) :: this
+    real :: area
+
+    area = this%area ()
+    print *, ' area = ', area
+  end subroutine print_area
+
+end module class_Rectangle
+
+
+program rectangle_Test
+  use class_Rectangle
+  implicit none
+
+  type (Rectangle) :: aRec
+  real areaE
+
+  aRec = Rectangle (2., 3.)
+  ! bp
+  call aRec%print_area
+
+end program rectangle_Test
+

--- a/gdb/testsuite/gdb.fortran/derived-type.exp
+++ b/gdb/testsuite/gdb.fortran/derived-type.exp
@@ -53,7 +53,7 @@ gdb_test_multiple "ptype q" $test {
 gdb_breakpoint [gdb_get_line_number "print"]
 gdb_continue_to_breakpoint "print"
 
-gdb_test "print p" "\\$\[0-9\]+ = \\( 1, 2\\.375 \\)"
+gdb_test "print p" "\\$\[0-9\]+ = \\( c = 1, d = 2\\.375 \\)"
 gdb_test "print p%c" "\\$\[0-9\]+ = 1"
 gdb_test "print p%d" "\\$\[0-9\]+ = 2\\.375"
 gdb_test "print q%a" "\\$\[0-9\]+ = 3\\.125"
@@ -75,10 +75,10 @@ gdb_test "print q%x%d" "\\$\[0-9\]+ = 2\\.375"
 
 set test "print q"
 gdb_test_multiple $test $test {
-    -re "\\$\[0-9\]+ = \\( 3.125, \\( 1, 2\\.375 \\), 'abcdefg' \\)\r\n$gdb_prompt $" {
+    -re "\\$\[0-9\]+ = \\( a = 3.125, x = \\( c = 1, d = 2\\.375 \\), b = 'abcdefg' \\)\r\n$gdb_prompt $" {
 	pass $test
     }
-    -re "\\$\[0-9\]+ = \\( 3.125, \\( 1, 2\\.375 \\), \\(97 'a', 98 'b', 99 'c', 100 'd', 101 'e', 102 'f', 103 'g'\\) \\)\r\n$gdb_prompt $" {
+    -re "\\$\[0-9\]+ = \\( a = 3.125, x = \\( 1, 2\\.375 \\), b = \\('abcdefg'\\) \\)\r\n$gdb_prompt $" {
 	# Compiler should produce string, not an array of characters.
 	setup_xfail "*-*-*"
 	fail $test

--- a/gdb/testsuite/gdb.fortran/vla-type.exp
+++ b/gdb/testsuite/gdb.fortran/vla-type.exp
@@ -33,7 +33,7 @@ set int [fortran_int4]
 # the debugger when accessing it.
 gdb_breakpoint [gdb_get_line_number "before-allocated"]
 gdb_continue_to_breakpoint "before-allocated"
-gdb_test "print twov" " = \\\( <not allocated>, <not allocated> \\\)" \
+gdb_test "print twov" " = \\\( ivla1 = <not allocated>, ivla2 = <not allocated> \\\)" \
   "print twov before allocated"
 gdb_test "print twov%ivla1" " = <not allocated>" \
   "print twov%ivla1 before allocated"
@@ -60,7 +60,7 @@ gdb_test "ptype twov" \
                      "\\s+$int :: ivla1\\\(5,12,99\\\)" \
                      "\\s+$int :: ivla2\\\(9,12\\\)" \
                      "End Type two" ]
-gdb_test "print twov" " = \\\( \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
+gdb_test "print twov" " = \\\( ivla1 = \\\(\\\( \\\( 1, 1, 1, 1, 1\\\)\
  \\\( 1, 1, 321, 1, 1\\\)\
  \\\( 1, 1, 1, 1, 1\\\) .*"