mirror of
https://github.com/espressif/binutils-gdb.git
synced 2025-06-26 13:56:22 +08:00
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.
This commit is contained in:
@ -1,3 +1,15 @@
|
||||
2020-07-25 Andrew Burgess <andrew.burgess@embecosm.com>
|
||||
|
||||
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 <tdevries@suse.de>
|
||||
|
||||
PR symtab/26243
|
||||
|
@ -1,3 +1,12 @@
|
||||
2020-07-25 Andrew Burgess <andrew.burgess@embecosm.com>
|
||||
|
||||
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 <tdevries@suse.de>
|
||||
|
||||
PR symtab/26243
|
||||
|
43
gdb/testsuite/gdb.fortran/class-allocatable-array.exp
Normal file
43
gdb/testsuite/gdb.fortran/class-allocatable-array.exp
Normal file
@ -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 <http://www.gnu.org/licenses/> .
|
||||
|
||||
# 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\\) \\)"
|
54
gdb/testsuite/gdb.fortran/class-allocatable-array.f90
Normal file
54
gdb/testsuite/gdb.fortran/class-allocatable-array.f90
Normal file
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
46
gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
Normal file
46
gdb/testsuite/gdb.fortran/pointer-to-pointer.exp
Normal file
@ -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 <http://www.gnu.org/licenses/> .
|
||||
|
||||
# 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\\)"
|
34
gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
Normal file
34
gdb/testsuite/gdb.fortran/pointer-to-pointer.f90
Normal file
@ -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 <http://www.gnu.org/licenses/>.
|
||||
|
||||
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
|
24
gdb/valops.c
24
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."));
|
||||
|
23
gdb/value.c
23
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<const gdb_byte> 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 *
|
||||
|
@ -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. */
|
||||
|
||||
|
Reference in New Issue
Block a user