From e79eb02f2f09baecffb144bac6804f975065466f Mon Sep 17 00:00:00 2001 From: Andrew Burgess Date: Thu, 9 Jul 2020 16:26:23 +0100 Subject: [PATCH] gdb/fortran: resolve dynamic types when readjusting after an indirection After dereferencing a pointer (in value_ind) or following a reference (in coerce_ref) we call readjust_indirect_value_type to "fixup" the type of the resulting value object. This fixup handles cases relating to the type of the resulting object being different (a sub-class) of the original pointers target type. If we encounter a pointer to a dynamic type then after dereferencing a pointer (in value_ind) the type of the object created will have had its dynamic type resolved. However, in readjust_indirect_value_type, we use the target type of the original pointer to "fixup" the type of the resulting value. In this case, the target type will be a dynamic type, so the resulting value object, once again has a dynamic type. This then triggers an assertion later within GDB. The solution I propose here is that we call resolve_dynamic_type on the pointer's target type (within readjust_indirect_value_type) so that the resulting value is not converted back to a dynamic type. The test case is based on the original test in the bug report. gdb/ChangeLog: PR fortran/23051 PR fortran/26139 * valops.c (value_ind): Pass address to readjust_indirect_value_type. * value.c (readjust_indirect_value_type): Make parameter non-const, and add extra address parameter. Resolve original type before using it. * value.h (readjust_indirect_value_type): Update function signature and comment. gdb/testsuite/ChangeLog: PR fortran/23051 PR fortran/26139 * gdb.fortran/class-allocatable-array.exp: New file. * gdb.fortran/class-allocatable-array.f90: New file. * gdb.fortran/pointer-to-pointer.exp: New file. * gdb.fortran/pointer-to-pointer.f90: New file. --- gdb/ChangeLog | 12 +++++ gdb/testsuite/ChangeLog | 9 ++++ .../gdb.fortran/class-allocatable-array.exp | 43 +++++++++++++++ .../gdb.fortran/class-allocatable-array.f90 | 54 +++++++++++++++++++ .../gdb.fortran/pointer-to-pointer.exp | 46 ++++++++++++++++ .../gdb.fortran/pointer-to-pointer.f90 | 34 ++++++++++++ gdb/valops.c | 24 +++++---- gdb/value.c | 23 +++++--- gdb/value.h | 7 ++- 9 files changed, 233 insertions(+), 19 deletions(-) create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.exp create mode 100644 gdb/testsuite/gdb.fortran/class-allocatable-array.f90 create mode 100644 gdb/testsuite/gdb.fortran/pointer-to-pointer.exp create mode 100644 gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 464ae137ccb..0c2c6552d95 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,15 @@ +2020-07-25 Andrew Burgess + + PR fortran/23051 + PR fortran/26139 + * valops.c (value_ind): Pass address to + readjust_indirect_value_type. + * value.c (readjust_indirect_value_type): Make parameter + non-const, and add extra address parameter. Resolve original type + before using it. + * value.h (readjust_indirect_value_type): Update function + signature and comment. + 2020-07-25 Tom de Vries PR symtab/26243 diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index e65caaf98d5..98a35cf3b90 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2020-07-25 Andrew Burgess + + PR fortran/23051 + PR fortran/26139 + * gdb.fortran/class-allocatable-array.exp: New file. + * gdb.fortran/class-allocatable-array.f90: New file. + * gdb.fortran/pointer-to-pointer.exp: New file. + * gdb.fortran/pointer-to-pointer.f90: New file. + 2020-07-25 Tom de Vries PR symtab/26243 diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp new file mode 100644 index 00000000000..9475ba3b393 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp @@ -0,0 +1,43 @@ +# Copyright 2020 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 . + +# Test that GDB can print an allocatable array that is a data field +# within a class like type. + +if {[skip_fortran_tests]} { return -1 } + +standard_testfile ".f90" +load_lib fortran.exp + +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90}]} { + return -1 +} + +if ![fortran_runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "Break Here"] +gdb_continue_to_breakpoint "Break Here" + +# If this first test fails then the Fortran compiler being used uses +# different names, or maybe a completely different approach, for +# representing class like structures. The following tests are +# cetainly going to fail. +gdb_test "print this" " = \\( _data = \[^\r\n\]+, _vptr = \[^\r\n\]+\\)" +gdb_test "print this%_data" " = \\(PTR TO -> \\( Type test_type \\)\\) \[^\r\n\]+" +gdb_test "print this%_data%b" " = \\(\\( 1, 2, 3\\) \\( 4, 5, 6\\) \\)" diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 new file mode 100644 index 00000000000..26d5fab0355 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/class-allocatable-array.f90 @@ -0,0 +1,54 @@ +! Copyright 2020 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 . + +module test_module + type test_type + integer a + real, allocatable :: b (:, :) + contains + procedure :: test_proc + end type test_type + +contains + + subroutine test_proc (this) + class(test_type), intent (inout) :: this + allocate (this%b (3, 2)) + call fill_array_2d (this%b) + print *, "" ! Break Here + contains + ! Helper subroutine to fill 2-dimensional array with unique + ! values. + subroutine fill_array_2d (array) + real, dimension (:,:) :: array + real :: counter + + counter = 1.0 + do i=LBOUND (array, 2), UBOUND (array, 2), 1 + do j=LBOUND (array, 1), UBOUND (array, 1), 1 + array (j,i) = counter + counter = counter + 1 + end do + end do + end subroutine fill_array_2d + end subroutine test_proc +end module + +program test + use test_module + implicit none + type(test_type) :: t + call t%test_proc () +end program test diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp new file mode 100644 index 00000000000..7129e431ed1 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.exp @@ -0,0 +1,46 @@ +# Copyright 2020 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 . + +# Test for GDB printing a pointer to a type containing a buffer. + +if {[skip_fortran_tests]} { return -1 } + +standard_testfile ".f90" +load_lib fortran.exp + +if {[prepare_for_testing ${testfile}.exp ${testfile} ${srcfile} \ + {debug f90}]} { + return -1 +} + +if ![fortran_runto_main] { + untested "could not run to main" + return -1 +} + +gdb_breakpoint [gdb_get_line_number "Break Here"] +gdb_continue_to_breakpoint "Break Here" + +gdb_test "print *buffer" \ + " = \\( alpha = \\(1\\.5, 2\\.5, 3\\.5, 4\\.5, 5\\.5\\) \\)" + +set l_buffer_type [multi_line \ + "Type l_buffer" \ + " real\\(kind=4\\) :: alpha\\(:\\)" \ + "End Type l_buffer" ] + +gdb_test "ptype buffer" "type = PTR TO -> \\( ${l_buffer_type} \\)" +gdb_test "ptype *buffer" "type = ${l_buffer_type}" +gdb_test "ptype buffer%alpha" "type = real\\(kind=4\\) \\(5\\)" diff --git a/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 new file mode 100644 index 00000000000..353217963a8 --- /dev/null +++ b/gdb/testsuite/gdb.fortran/pointer-to-pointer.f90 @@ -0,0 +1,34 @@ +! Copyright 2020 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 . + +program allocate_array + + type l_buffer + real, dimension(:), pointer :: alpha + end type l_buffer + type(l_buffer), pointer :: buffer + + allocate (buffer) + allocate (buffer%alpha (5)) + + buffer%alpha (1) = 1.5 + buffer%alpha (2) = 2.5 + buffer%alpha (3) = 3.5 + buffer%alpha (4) = 4.5 + buffer%alpha (5) = 5.5 + + print *, buffer%alpha ! Break Here. + +end program allocate_array diff --git a/gdb/valops.c b/gdb/valops.c index 033fd42036a..0eb2b096211 100644 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -1559,20 +1559,24 @@ value_ind (struct value *arg1) enc_type = check_typedef (value_enclosing_type (arg1)); enc_type = TYPE_TARGET_TYPE (enc_type); + CORE_ADDR base_addr; if (check_typedef (enc_type)->code () == TYPE_CODE_FUNC || check_typedef (enc_type)->code () == TYPE_CODE_METHOD) - /* For functions, go through find_function_addr, which knows - how to handle function descriptors. */ - arg2 = value_at_lazy (enc_type, - find_function_addr (arg1, NULL)); + { + /* For functions, go through find_function_addr, which knows + how to handle function descriptors. */ + base_addr = find_function_addr (arg1, NULL); + } else - /* Retrieve the enclosing object pointed to. */ - arg2 = value_at_lazy (enc_type, - (value_as_address (arg1) - - value_pointed_to_offset (arg1))); - + { + /* Retrieve the enclosing object pointed to. */ + base_addr = (value_as_address (arg1) + - value_pointed_to_offset (arg1)); + } + arg2 = value_at_lazy (enc_type, base_addr); enc_type = value_type (arg2); - return readjust_indirect_value_type (arg2, enc_type, base_type, arg1); + return readjust_indirect_value_type (arg2, enc_type, base_type, + arg1, base_addr); } error (_("Attempt to take contents of a non-pointer value.")); diff --git a/gdb/value.c b/gdb/value.c index 3a5b02bcb46..aac9baaaf56 100644 --- a/gdb/value.c +++ b/gdb/value.c @@ -3629,10 +3629,20 @@ coerce_ref_if_computed (const struct value *arg) struct value * readjust_indirect_value_type (struct value *value, struct type *enc_type, const struct type *original_type, - const struct value *original_value) + struct value *original_value, + CORE_ADDR original_value_address) { + gdb_assert (original_type->code () == TYPE_CODE_PTR + || TYPE_IS_REFERENCE (original_type)); + + struct type *original_target_type = TYPE_TARGET_TYPE (original_type); + gdb::array_view view; + struct type *resolved_original_target_type + = resolve_dynamic_type (original_target_type, view, + original_value_address); + /* Re-adjust type. */ - deprecated_set_value_type (value, TYPE_TARGET_TYPE (original_type)); + deprecated_set_value_type (value, resolved_original_target_type); /* Add embedding info. */ set_value_enclosing_type (value, enc_type); @@ -3659,12 +3669,11 @@ coerce_ref (struct value *arg) enc_type = check_typedef (value_enclosing_type (arg)); enc_type = TYPE_TARGET_TYPE (enc_type); - retval = value_at_lazy (enc_type, - unpack_pointer (value_type (arg), - value_contents (arg))); + CORE_ADDR addr = unpack_pointer (value_type (arg), value_contents (arg)); + retval = value_at_lazy (enc_type, addr); enc_type = value_type (retval); - return readjust_indirect_value_type (retval, enc_type, - value_type_arg_tmp, arg); + return readjust_indirect_value_type (retval, enc_type, value_type_arg_tmp, + arg, addr); } struct value * diff --git a/gdb/value.h b/gdb/value.h index 70c3d5667ae..12e4a13e3e4 100644 --- a/gdb/value.h +++ b/gdb/value.h @@ -488,7 +488,9 @@ extern struct value *coerce_ref_if_computed (const struct value *arg); /* Setup a new value type and enclosing value type for dereferenced value VALUE. ENC_TYPE is the new enclosing type that should be set. ORIGINAL_TYPE and - ORIGINAL_VAL are the type and value of the original reference or pointer. + ORIGINAL_VAL are the type and value of the original reference or + pointer. ORIGINAL_VALUE_ADDRESS is the address within VALUE, that is + the address that was dereferenced. Note, that VALUE is modified by this function. @@ -497,7 +499,8 @@ extern struct value *coerce_ref_if_computed (const struct value *arg); extern struct value * readjust_indirect_value_type (struct value *value, struct type *enc_type, const struct type *original_type, - const struct value *original_val); + struct value *original_val, + CORE_ADDR original_value_address); /* Convert a REF to the object referenced. */ -- 2.30.2