From FEDORA_PATCHES Mon Sep 17 00:00:00 2001 From: Keith Seitz Date: Wed, 2 Dec 2020 17:39:33 -0500 Subject: gdb-rhbz1905701-DWARF-data_location.patch ;; Backport "fortran dynamic type related fixes" ;; Andrew Burgess (RH BZ 1905701) commit e79eb02f2f09baecffb144bac6804f975065466f 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. diff --git a/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c new file mode 100644 --- /dev/null +++ b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.c @@ -0,0 +1,63 @@ +/* Copyright 2014-2020 Free Software Foundation, Inc. + + This file is part of GDB. + + 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 . */ + +/* This C file simulates the implementation of object pointers in + GraalVM Java native images where the object data is not addressed + directly. It serves as a regression test for a bug where printing + of such redirected data structures suffers from a gdb exception. + + Debugging information on how to decode an object pointer to + identify the address of the underlying data will be generated + separately by the testcase using that file. */ + +#include +#include + +struct Object { + struct Object *next; + int val; +}; + +struct Object *testOop; + +extern int debugMe() { + return 0; +} + +struct Object *newObject() { + char *bytes = malloc(sizeof(struct Object)); + return (struct Object *)bytes; +} + +int +main (void) +{ + struct Object *obj1 = newObject(); + struct Object *obj2 = newObject(); + struct Object *obj3 = newObject(); + obj1->val = 0; + obj2->val = 1; + obj3->val = 2; + + obj1->next = obj2; + obj2->next = obj3; + obj3->next = obj1; + + testOop = obj1; + + return debugMe(); +} diff --git a/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp new file mode 100644 --- /dev/null +++ b/gdb/testsuite/gdb.dwarf2/graalvm-data-loc2.exp @@ -0,0 +1,122 @@ +# Copyright 2014-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 . +load_lib dwarf.exp + +# This test can only be run on targets which support DWARF-2 and use gas. +if {![dwarf2_support]} { + return 0 +} + +standard_testfile .c -dw.S + +if { [prepare_for_testing "failed to prepare" ${testfile} ${srcfile}] } { + return -1 +} + +# Make some DWARF for the test. +set asm_file [standard_output_file $srcfile2] +Dwarf::assemble $asm_file { + + cu {} { + DW_TAG_compile_unit { + {DW_AT_language @DW_LANG_C99} + {DW_AT_name data-loc2.c} + {DW_AT_comp_dir /tmp} + } { + declare_labels integer_label struct_label pointer_label + + integer_label: DW_TAG_base_type { + {DW_AT_byte_size 4 DW_FORM_sdata} + {DW_AT_encoding @DW_ATE_signed} + {DW_AT_name integer} + } + + struct_label: DW_TAG_structure_type { + {DW_AT_name "Object"} + {DW_AT_byte_size 20 DW_FORM_sdata} + {DW_AT_data_location { + DW_OP_push_object_address + } SPECIAL_expr} + } { + member { + {name next} + {type :$pointer_label} + {data_member_location 0 data1} + } + member { + {name val} + {type :$integer_label} + {data_member_location 8 data1} + } + } + pointer_label: DW_TAG_pointer_type { + {DW_AT_byte_size 4 DW_FORM_sdata} + {DW_AT_type :$struct_label} + } + DW_TAG_variable { + {DW_AT_name testOop} + {DW_AT_type :$pointer_label} + {DW_AT_location { + DW_OP_addr [gdb_target_symbol testOop] + } SPECIAL_expr} + {external 1 flag} + } + } + } +} + +# Now that we've generated the DWARF debugging info, rebuild our +# program using our debug info instead of the info generated by +# the compiler. + +if { [prepare_for_testing "failed to prepare" ${testfile} \ + [list $srcfile $asm_file] {nodebug}] } { + return -1 +} + +if ![runto_main] { + return -1 +} + +# ensure the object network is set up as expected and check that +# printing of structs which employ the data_location does not +# fail with a gdb exception + +gdb_test "break debugMe" \ + "Breakpoint .*" \ + "set breakpoint at debugMe" + +gdb_continue_to_breakpoint "continue to debugMe" + +gdb_test "print testOop->val" \ + ".* = 0" + +gdb_test "print testOop->next->val" \ + ".* = 1" + +gdb_test "print testOop->next->next->val" \ + ".* = 2" + +gdb_test "print *testOop" \ + ".* = {next = .*, val = 0}" \ + "print contents of struct" + +gdb_test "print *testOop->next" \ + ".* = {next = .*, val = 1}" \ + "print contents of an indirect struct" + +gdb_test "print *testOop->next->next" \ + ".* = {next = .*, val = 2}" \ + "print contents of a double indirect struct" diff --git a/gdb/testsuite/gdb.fortran/class-allocatable-array.exp b/gdb/testsuite/gdb.fortran/class-allocatable-array.exp new file mode 100644 --- /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 {![runto MAIN__]} { + untested main"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 --- /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 --- /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 {![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 --- /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 --- a/gdb/valops.c +++ b/gdb/valops.c @@ -1573,42 +1573,34 @@ value_ind (struct value *arg1) if (TYPE_CODE (base_type) == TYPE_CODE_PTR) { struct type *enc_type; - CORE_ADDR addr; - - if (type_not_associated (base_type)) - error (_("Attempt to take contents of a not associated pointer.")); - - if (NULL != TYPE_DATA_LOCATION (TYPE_TARGET_TYPE (base_type))) - addr = value_address (arg1); - else - addr = value_as_address (arg1); - - if (addr != 0) - TYPE_TARGET_TYPE (base_type) = - resolve_dynamic_type (TYPE_TARGET_TYPE (base_type), NULL, addr); /* We may be pointing to something embedded in a larger object. Get the real type of the enclosing object. */ enc_type = check_typedef (value_enclosing_type (arg1)); enc_type = TYPE_TARGET_TYPE (enc_type); + CORE_ADDR base_addr; if (TYPE_CODE (check_typedef (enc_type)) == TYPE_CODE_FUNC || TYPE_CODE (check_typedef (enc_type)) == 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, - (addr - 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.")); - return 0; /* For lint -- never reached. */ } /* Create a value for an array by allocating space in GDB, copying the diff --git a/gdb/value.c b/gdb/value.c --- a/gdb/value.c +++ b/gdb/value.c @@ -3611,10 +3611,19 @@ 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 (TYPE_CODE (original_type) == TYPE_CODE_PTR + || TYPE_IS_REFERENCE (original_type)); + + struct type *original_target_type = TYPE_TARGET_TYPE (original_type); + struct type *resolved_original_target_type + = resolve_dynamic_type (original_target_type, NULL, + 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); @@ -3641,12 +3650,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 --- a/gdb/value.h +++ b/gdb/value.h @@ -487,7 +487,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. @@ -496,7 +498,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. */