diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/ChangeLog | 11 | ||||
| -rw-r--r-- | gcc/dwarf2out.c | 185 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 9 | ||||
| -rw-r--r-- | gcc/testsuite/gcc.dg/guality/guality.exp | 77 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/guality/arg1.f90 | 15 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/guality/guality.exp | 29 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/guality/pr41558.f90 | 10 | ||||
| -rw-r--r-- | gcc/testsuite/lib/gcc-gdb-test.exp | 91 |
8 files changed, 250 insertions, 177 deletions
diff --git a/gcc/ChangeLog b/gcc/ChangeLog index 2f611f0..d4b7a7f 100644 --- a/gcc/ChangeLog +++ b/gcc/ChangeLog @@ -1,3 +1,14 @@ +2009-10-05 Jakub Jelinek <jakub@redhat.com> + + PR debug/41558 + * dwarf2out.c (loc_by_reference): Removed. + (dw_loc_list_1): New function. + (dw_loc_list): Remove toplev argument, add want_address argument. + Don't look at decl_by_reference_p at all. Use dw_loc_list_1. + (loc_list_from_tree) <case VAR_DECL>: Pass want_address rather than + want_address == 2 to dw_loc_list. For successful dw_loc_list + set have_address to 1 only if want_address is not 0. + 2009-10-05 Richard Sandiford <rdsandiford@googlemail.com> * config/mips/mips-protos.h (mips_trampoline_code_size): Declare. diff --git a/gcc/dwarf2out.c b/gcc/dwarf2out.c index 26e8594..b92f69c 100644 --- a/gcc/dwarf2out.c +++ b/gcc/dwarf2out.c @@ -13596,71 +13596,101 @@ decl_by_reference_p (tree decl) && DECL_BY_REFERENCE (decl)); } +/* Return single element location list containing loc descr REF. */ -/* Dereference a location expression LOC if DECL is passed by invisible - reference. */ - -static dw_loc_descr_ref -loc_by_reference (dw_loc_descr_ref loc, tree decl) +static dw_loc_list_ref +single_element_loc_list (dw_loc_descr_ref ref) { - HOST_WIDE_INT size; - enum dwarf_location_atom op; + return new_loc_list (ref, NULL, NULL, NULL, 0); +} - if (loc == NULL) - return NULL; +/* Helper function for dw_loc_list. Compute proper Dwarf location descriptor + for VARLOC. */ - if (!decl_by_reference_p (decl)) - return loc; +static dw_loc_descr_ref +dw_loc_list_1 (tree loc, rtx varloc, int want_address, + enum var_init_status initialized) +{ + int have_address = 0; + dw_loc_descr_ref descr; + enum machine_mode mode; - /* If loc is DW_OP_reg{0...31,x}, don't add DW_OP_deref, instead - change it into corresponding DW_OP_breg{0...31,x} 0. Then the - location expression is considered to be address of a memory location, - rather than the register itself. */ - if (((loc->dw_loc_opc >= DW_OP_reg0 && loc->dw_loc_opc <= DW_OP_reg31) - || loc->dw_loc_opc == DW_OP_regx) - && (loc->dw_loc_next == NULL - || (loc->dw_loc_next->dw_loc_opc == DW_OP_GNU_uninit - && loc->dw_loc_next->dw_loc_next == NULL))) + if (want_address != 2) { - if (loc->dw_loc_opc == DW_OP_regx) + gcc_assert (GET_CODE (varloc) == VAR_LOCATION); + /* Single part. */ + if (GET_CODE (XEXP (varloc, 1)) != PARALLEL) { - loc->dw_loc_opc = DW_OP_bregx; - loc->dw_loc_oprnd2.v.val_int = 0; + varloc = XEXP (XEXP (varloc, 1), 0); + mode = GET_MODE (varloc); + if (MEM_P (varloc)) + { + varloc = XEXP (varloc, 0); + have_address = 1; + } + descr = mem_loc_descriptor (varloc, mode, initialized); } else + return 0; + } + else + { + descr = loc_descriptor (varloc, DECL_MODE (loc), initialized); + have_address = 1; + } + + if (!descr) + return 0; + + if (want_address == 2 && !have_address + && (dwarf_version >= 4 || !dwarf_strict)) + { + if (int_size_in_bytes (TREE_TYPE (loc)) > DWARF2_ADDR_SIZE) { - loc->dw_loc_opc - = (enum dwarf_location_atom) - (loc->dw_loc_opc + (DW_OP_breg0 - DW_OP_reg0)); - loc->dw_loc_oprnd1.v.val_int = 0; + expansion_failed (loc, NULL_RTX, + "DWARF address size mismatch"); + return 0; } - return loc; + add_loc_descr (&descr, new_loc_descr (DW_OP_stack_value, 0, 0)); + have_address = 1; + } + /* Show if we can't fill the request for an address. */ + if (want_address && !have_address) + { + expansion_failed (loc, NULL_RTX, + "Want address and only have value"); + return 0; } - size = int_size_in_bytes (TREE_TYPE (decl)); - if (size > DWARF2_ADDR_SIZE || size == -1) - return 0; - else if (size == DWARF2_ADDR_SIZE) - op = DW_OP_deref; - else - op = DW_OP_deref_size; - add_loc_descr (&loc, new_loc_descr (op, size, 0)); - return loc; -} + /* If we've got an address and don't want one, dereference. */ + if (!want_address && have_address) + { + HOST_WIDE_INT size = int_size_in_bytes (TREE_TYPE (loc)); + enum dwarf_location_atom op; -/* Return single element location list containing loc descr REF. */ + if (size > DWARF2_ADDR_SIZE || size == -1) + { + expansion_failed (loc, NULL_RTX, + "DWARF address size mismatch"); + return 0; + } + else if (size == DWARF2_ADDR_SIZE) + op = DW_OP_deref; + else + op = DW_OP_deref_size; -static dw_loc_list_ref -single_element_loc_list (dw_loc_descr_ref ref) -{ - return new_loc_list (ref, NULL, NULL, NULL, 0); + add_loc_descr (&descr, new_loc_descr (op, size, 0)); + } + + return descr; } /* Return dwarf representation of location list representing for - LOC_LIST of DECL. */ + LOC_LIST of DECL. WANT_ADDRESS has the same meaning as in + loc_list_from_tree function. */ static dw_loc_list_ref -dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) +dw_loc_list (var_loc_list * loc_list, tree decl, int want_address) { const char *endname, *secname; dw_loc_list_ref list; @@ -13670,8 +13700,6 @@ dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) dw_loc_descr_ref descr; char label_id[MAX_ARTIFICIAL_LABEL_BYTES]; - bool by_reference = decl_by_reference_p (decl); - /* Now that we know what section we are using for a base, actually construct the list of locations. The first location information is what is passed to the @@ -13684,28 +13712,14 @@ dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) a range of [last location start, end of function label]. */ node = loc_list->first; - varloc = NOTE_VAR_LOCATION (node->var_loc_note); secname = secname_for_decl (decl); if (NOTE_VAR_LOCATION_LOC (node->var_loc_note)) initialized = NOTE_VAR_LOCATION_STATUS (node->var_loc_note); else initialized = VAR_INIT_STATUS_INITIALIZED; - - if (!toplevel || by_reference) - { - gcc_assert (GET_CODE (varloc) == VAR_LOCATION); - /* Single part. */ - if (GET_CODE (XEXP (varloc, 1)) != PARALLEL) - descr = loc_by_reference (mem_loc_descriptor (XEXP (XEXP (varloc, 1), 0), - TYPE_MODE (TREE_TYPE (decl)), - initialized), - decl); - else - descr = NULL; - } - else - descr = loc_descriptor (varloc, DECL_MODE (decl), initialized); + varloc = NOTE_VAR_LOCATION (node->var_loc_note); + descr = dw_loc_list_1 (decl, varloc, want_address, initialized); if (loc_list && loc_list->first != loc_list->last) list = new_loc_list (descr, node->label, node->next->label, secname, 1); @@ -13721,22 +13735,9 @@ dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) { /* The variable has a location between NODE->LABEL and NODE->NEXT->LABEL. */ - enum var_init_status initialized = - NOTE_VAR_LOCATION_STATUS (node->var_loc_note); + initialized = NOTE_VAR_LOCATION_STATUS (node->var_loc_note); varloc = NOTE_VAR_LOCATION (node->var_loc_note); - if (!toplevel || by_reference) - { - gcc_assert (GET_CODE (varloc) == VAR_LOCATION); - /* Single part. */ - if (GET_CODE (XEXP (varloc, 1)) != PARALLEL) - descr = mem_loc_descriptor (XEXP (XEXP (varloc, 1), 0), - TYPE_MODE (TREE_TYPE (decl)), initialized); - else - descr = NULL; - descr = loc_by_reference (descr, decl); - } - else - descr = loc_descriptor (varloc, DECL_MODE (decl), initialized); + descr = dw_loc_list_1 (decl, varloc, want_address, initialized); add_loc_descr_to_loc_list (&list, descr, node->label, node->next->label, secname); } @@ -13745,9 +13746,6 @@ dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) it keeps its location until the end of function. */ if (NOTE_VAR_LOCATION_LOC (node->var_loc_note) != NULL_RTX) { - enum var_init_status initialized = - NOTE_VAR_LOCATION_STATUS (node->var_loc_note); - if (!current_function_decl) endname = text_end_label; else @@ -13757,20 +13755,9 @@ dw_loc_list (var_loc_list * loc_list, tree decl, bool toplevel) endname = ggc_strdup (label_id); } + initialized = NOTE_VAR_LOCATION_STATUS (node->var_loc_note); varloc = NOTE_VAR_LOCATION (node->var_loc_note); - if (!toplevel || by_reference) - { - gcc_assert (GET_CODE (varloc) == VAR_LOCATION); - /* Single part. */ - if (GET_CODE (XEXP (varloc, 1)) != PARALLEL) - descr = mem_loc_descriptor (XEXP (XEXP (varloc, 1), 0), - TYPE_MODE (TREE_TYPE (decl)), initialized); - else - descr = NULL; - descr = loc_by_reference (descr, decl); - } - else - descr = loc_descriptor (varloc, DECL_MODE (decl), initialized); + descr = dw_loc_list_1 (decl, varloc, want_address, initialized); add_loc_descr_to_loc_list (&list, descr, node->label, endname, secname); } return list; @@ -13948,11 +13935,7 @@ loc_list_for_address_of_addr_expr_of_indirect_ref (tree loc, bool toplev) If WANT_ADDRESS is 1, expression computing address of LOC will be returned if WANT_ADDRESS is 2, expression computing address useable in location will be returned (i.e. DW_OP_reg can be used - to refer to register values) - TODO: Dwarf4 adds types to the stack machine that ought to be used here - DW_OP_stack_value will help in cases where we fail to find address of the - expression. - */ + to refer to register values). */ static dw_loc_list_ref loc_list_from_tree (tree loc, int want_address) @@ -14087,8 +14070,8 @@ loc_list_from_tree (tree loc, int want_address) var_loc_list *loc_list = lookup_decl_loc (loc); if (loc_list && loc_list->first - && (list_ret = dw_loc_list (loc_list, loc, want_address == 2))) - have_address = 1; + && (list_ret = dw_loc_list (loc_list, loc, want_address))) + have_address = want_address != 0; else if (rtl == NULL_RTX) { expansion_failed (loc, NULL_RTX, "DECL has no RTL"); diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index bf1b532..e2b31f3 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,12 @@ +2009-10-05 Jakub Jelinek <jakub@redhat.com> + + PR debug/41558 + * gcc.dg/guality/guality.exp: Move gdb-test proc into... + * lib/gcc-gdb-test.exp: ... here. New file. + * gfortran.dg/guality/guality.exp: New file. + * gfortran.dg/guality/pr41558.f90: New test. + * gfortran.dg/guality/arg1.f90: New test. + 2009-10-05 Paul Thomas <pault@gcc.gnu.org> * gfortran.dg/dynamic_dispatch_1.f90: New test. diff --git a/gcc/testsuite/gcc.dg/guality/guality.exp b/gcc/testsuite/gcc.dg/guality/guality.exp index 82185fb..d4ee686 100644 --- a/gcc/testsuite/gcc.dg/guality/guality.exp +++ b/gcc/testsuite/gcc.dg/guality/guality.exp @@ -1,6 +1,7 @@ # This harness is for tests that should be run at all optimisation levels. load_lib gcc-dg.exp +load_lib gcc-gdb-test.exp # Disable on darwin until radr://7264615 is resolved. if { [istarget *-*-darwin*] } { @@ -20,82 +21,6 @@ proc check_guality {args} { return $ret } -# Utility for testing variable values using gdb, invoked via dg-final. -# Call pass if variable has the desired value, otherwise fail. -# -# Argument 0 is the line number on which to put a breakpoint -# Argument 1 is the name of the variable to be checked -# Argument 2 is the expected value of the variable -# Argument 3 handles expected failures and the like -proc gdb-test { args } { - if { ![isnative] || [is_remote target] } { return } - - if { [llength $args] >= 4 } { - switch [dg-process-target [lindex $args 3]] { - "S" { } - "N" { return } - "F" { setup_xfail "*-*-*" } - "P" { } - } - } - - # This assumes that we are three frames down from dg-test, and that - # it still stores the filename of the testcase in a local variable "name". - # A cleaner solution would require a new DejaGnu release. - upvar 2 name testcase - upvar 2 prog prog - - set gdb_name $::env(GUALITY_GDB_NAME) - set testname "$testcase line [lindex $args 0] [lindex $args 1] == [lindex $args 2]" - set output_file "[file rootname [file tail $prog]].exe" - set cmd_file "[file rootname [file tail $prog]].gdb" - - set fd [open $cmd_file "w"] - puts $fd "break [lindex $args 0]" - puts $fd "run" - puts $fd "print [lindex $args 1]" - puts $fd "print [lindex $args 2]" - puts $fd "quit" - close $fd - - send_log "Spawning: $gdb_name -nx -nw -quiet -x $cmd_file ./$output_file\n" - set res [remote_spawn target "$gdb_name -nx -nw -quiet -x $cmd_file ./$output_file"] - if { $res < 0 || $res == "" } { - unsupported "$testname" - return - } - - remote_expect target [timeout_value] { - -re {[\n\r]\$1 = ([^\n\r]*)[\n\r]+\$2 = ([^\n\r]*)[\n\r]} { - set first $expect_out(1,string) - set second $expect_out(2,string) - if { $first == $second } { - pass "$testname" - } else { - send_log "$first != $second\n" - fail "$testname" - } - remote_close target - return - } - # Too old GDB - -re "Unhandled dwarf expression|Error in sourced command file" { - unsupported "$testname" - remote_close target - return - } - timeout { - unsupported "$testname" - remote_close target - return - } - } - - remote_close target - unsupported "$testname" - return -} - dg-init global GDB diff --git a/gcc/testsuite/gfortran.dg/guality/arg1.f90 b/gcc/testsuite/gfortran.dg/guality/arg1.f90 new file mode 100644 index 0000000..332a4ed --- /dev/null +++ b/gcc/testsuite/gfortran.dg/guality/arg1.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! { dg-options "-g" } + integer :: a(10), b(12) + call sub (a, 10) + call sub (b, 12) + write (*,*) a, b +end + +subroutine sub (a, n) + integer :: a(n), n + do i = 1, n + a(i) = i + end do + write (*,*) a ! { dg-final { gdb-test 14 "a(10)" "10" } } +end subroutine diff --git a/gcc/testsuite/gfortran.dg/guality/guality.exp b/gcc/testsuite/gfortran.dg/guality/guality.exp new file mode 100644 index 0000000..2444d8d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/guality/guality.exp @@ -0,0 +1,29 @@ +# This harness is for tests that should be run at all optimisation levels. + +load_lib gfortran-dg.exp +load_lib gcc-gdb-test.exp + +# Disable on darwin until radr://7264615 is resolved. +if { [istarget *-*-darwin*] } { + return +} + +dg-init + +global GDB +if ![info exists ::env(GUALITY_GDB_NAME)] { + if [info exists GDB] { + set guality_gdb_name "$GDB" + } else { + set guality_gdb_name "[transform gdb]" + } + setenv GUALITY_GDB_NAME "$guality_gdb_name" +} + +gfortran-dg-runtest [lsort [glob $srcdir/$subdir/*.\[fF\]{,90,95,03,08} ]] "" + +if [info exists guality_gdb_name] { + unsetenv GUALITY_GDB_NAME +} + +dg-finish diff --git a/gcc/testsuite/gfortran.dg/guality/pr41558.f90 b/gcc/testsuite/gfortran.dg/guality/pr41558.f90 new file mode 100644 index 0000000..9d1e833 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/guality/pr41558.f90 @@ -0,0 +1,10 @@ +! PR debug/41558 +! { dg-do run } +! { dg-options "-g" } + +subroutine f (s) + character(len=3) :: s + write (*,*), s ! { dg-final { gdb-test 7 "s" "'foo'" } } +end + call f ('foo') +end diff --git a/gcc/testsuite/lib/gcc-gdb-test.exp b/gcc/testsuite/lib/gcc-gdb-test.exp new file mode 100644 index 0000000..c8933c2 --- /dev/null +++ b/gcc/testsuite/lib/gcc-gdb-test.exp @@ -0,0 +1,91 @@ +# Copyright (C) 2009 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 GCC; see the file COPYING3. If not see +# <http://www.gnu.org/licenses/>. + +# Utility for testing variable values using gdb, invoked via dg-final. +# Call pass if variable has the desired value, otherwise fail. +# +# Argument 0 is the line number on which to put a breakpoint +# Argument 1 is the name of the variable to be checked +# Argument 2 is the expected value of the variable +# Argument 3 handles expected failures and the like +proc gdb-test { args } { + if { ![isnative] || [is_remote target] } { return } + + if { [llength $args] >= 4 } { + switch [dg-process-target [lindex $args 3]] { + "S" { } + "N" { return } + "F" { setup_xfail "*-*-*" } + "P" { } + } + } + + # This assumes that we are three frames down from dg-test, and that + # it still stores the filename of the testcase in a local variable "name". + # A cleaner solution would require a new DejaGnu release. + upvar 2 name testcase + upvar 2 prog prog + + set gdb_name $::env(GUALITY_GDB_NAME) + set testname "$testcase line [lindex $args 0] [lindex $args 1] == [lindex $args 2]" + set output_file "[file rootname [file tail $prog]].exe" + set cmd_file "[file rootname [file tail $prog]].gdb" + + set fd [open $cmd_file "w"] + puts $fd "break [lindex $args 0]" + puts $fd "run" + puts $fd "print [lindex $args 1]" + puts $fd "print [lindex $args 2]" + puts $fd "quit" + close $fd + + send_log "Spawning: $gdb_name -nx -nw -quiet -x $cmd_file ./$output_file\n" + set res [remote_spawn target "$gdb_name -nx -nw -quiet -x $cmd_file ./$output_file"] + if { $res < 0 || $res == "" } { + unsupported "$testname" + return + } + + remote_expect target [timeout_value] { + -re {[\n\r]\$1 = ([^\n\r]*)[\n\r]+\$2 = ([^\n\r]*)[\n\r]} { + set first $expect_out(1,string) + set second $expect_out(2,string) + if { $first == $second } { + pass "$testname" + } else { + send_log "$first != $second\n" + fail "$testname" + } + remote_close target + return + } + # Too old GDB + -re "Unhandled dwarf expression|Error in sourced command file" { + unsupported "$testname" + remote_close target + return + } + timeout { + unsupported "$testname" + remote_close target + return + } + } + + remote_close target + unsupported "$testname" + return +} |