Skip to content

R
riscv-gcc-1
Commit 7555009a by Jakub Jelinek Committed by Jakub Jelinek
Options

re PR debug/41558 (gfortran -O code excessive DW_OP_deref's) 

	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.

	* 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.

From-SVN: r152467
parent c640a3bd
Showing with 250 additions and 177 deletions
gcc/ChangeLog
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.
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");
......
gcc/testsuite/ChangeLog
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.
......
gcc/testsuite/gcc.dg/guality/guality.exp
# 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
......
gcc/testsuite/gfortran.dg/guality/arg1.f90 0 → 100644
! { 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
gcc/testsuite/gfortran.dg/guality/guality.exp 0 → 100644
# 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
gcc/testsuite/gfortran.dg/guality/pr41558.f90 0 → 100644
! 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
gcc/testsuite/lib/gcc-gdb-test.exp 0 → 100644
# 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
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment