diff options
| -rw-r--r-- | gdb/ChangeLog | 5 | ||||
| -rw-r--r-- | gdb/f-valprint.c | 34 | ||||
| -rw-r--r-- | gdb/testsuite/ChangeLog | 9 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/derived-type-function.exp | 38 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/derived-type-function.f90 | 62 | ||||
| -rw-r--r-- | gdb/testsuite/gdb.fortran/derived-type.exp | 6 | ||||
| -rwxr-xr-x | gdb/testsuite/gdb.fortran/vla-type.exp | 4 |
7 files changed, 145 insertions, 13 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index b4331ea..68c754f 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,8 @@ +2016-06-21 Walfred Tedeschi <walfred.tedeschi@intel.com> + + * f-valprint.c (f_val_print): Add field names for printing + derived types fields. + 2016-06-21 Andreas Arnez <arnez@linux.vnet.ibm.com> * s390-linux-tdep.c (s390_iterate_over_regset_sections): Fix typo diff --git a/gdb/f-valprint.c b/gdb/f-valprint.c index 1264737..08215e2 100644 --- 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; diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index ae0edb3..7939954 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2016-06-21 Walfred Tedeschi <walfred.tedeschi@intel.com> + + * 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 <palves@redhat.com> * gdb.base/new-ui.exp: New file. diff --git a/gdb/testsuite/gdb.fortran/derived-type-function.exp b/gdb/testsuite/gdb.fortran/derived-type-function.exp new file mode 100644 index 0000000..2a9353b --- /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 (walfred.tedeschi@intel.com). + +# 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" diff --git a/gdb/testsuite/gdb.fortran/derived-type-function.f90 b/gdb/testsuite/gdb.fortran/derived-type-function.f90 new file mode 100644 index 0000000..375947b --- /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 (walfred.tedeschi@intel.com). + +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 + diff --git a/gdb/testsuite/gdb.fortran/derived-type.exp b/gdb/testsuite/gdb.fortran/derived-type.exp index 73eb1f4..32431bc 100644 --- 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 diff --git a/gdb/testsuite/gdb.fortran/vla-type.exp b/gdb/testsuite/gdb.fortran/vla-type.exp index 68884ce..401782b 100755 --- 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\\\) .*" |