[gdb/testsuite] Make gdb.base/dbx.exp more robust
Test-case gdb.base/dbx.exp overrides: - the GDBFLAGS variable - the gdb_file_cmd proc There's code at the end of the test-case to restore both, but that's not guaranteed to be executed. Fix this by: - using save_vars to restore GDBFLAGS - using a new proc with_override to restore gdb_file_cmd Tested on x86_64-linux. gdb/testsuite/ChangeLog: 2020-06-11 Tom de Vries <tdevries@suse.de> * lib/gdb.exp (with_override): New proc, factored out of ... * gdb.base/dbx.exp: ... here. Use with_override and save_vars.
This commit is contained in:
parent
14962256b3
commit
a8baf0a32b
|
@ -1,3 +1,8 @@
|
|||
2020-06-11 Tom de Vries <tdevries@suse.de>
|
||||
|
||||
* lib/gdb.exp (with_override): New proc, factored out of ...
|
||||
* gdb.base/dbx.exp: ... here. Use with_override and save_vars.
|
||||
|
||||
2020-06-10 Tom de Vries <tdevries@suse.de>
|
||||
|
||||
* gdb.ada/ptype_union.exp: Remove PR24713 workaround.
|
||||
|
|
|
@ -147,11 +147,8 @@ proc dbx_reinitialize_dir { subdir } {
|
|||
# right sequence of events, allowing gdb_load to do its normal thing? This way
|
||||
# remotes and simulators will work, too.
|
||||
#
|
||||
# [drow 2002-03-30]: We can restore the old gdb_file_cmd afterwards, though.
|
||||
set old_gdb_file_cmd_args [info args gdb_file_cmd]
|
||||
set old_gdb_file_cmd_body [info body gdb_file_cmd]
|
||||
|
||||
proc gdb_file_cmd {arg} {
|
||||
proc local_gdb_file_cmd {arg} {
|
||||
global loadpath
|
||||
global loadfile
|
||||
global GDB
|
||||
|
@ -286,24 +283,24 @@ proc test_func { } {
|
|||
# Start with a fresh gdb.
|
||||
|
||||
gdb_exit
|
||||
global GDBFLAGS
|
||||
set saved_gdbflags $GDBFLAGS
|
||||
|
||||
set GDBFLAGS "$GDBFLAGS --dbx"
|
||||
gdb_start
|
||||
dbx_reinitialize_dir $srcdir/$subdir
|
||||
gdb_load ${binfile}
|
||||
with_override gdb_file_cmd local_gdb_file_cmd {
|
||||
save_vars GDBFLAGS {
|
||||
set GDBFLAGS "$GDBFLAGS --dbx"
|
||||
|
||||
test_breakpoints
|
||||
test_assign
|
||||
test_whereis
|
||||
gdb_test "file average.c:1" "1\[ \t\]+/. This is a sample program.*"
|
||||
test_func
|
||||
gdb_start
|
||||
dbx_reinitialize_dir $srcdir/$subdir
|
||||
gdb_load ${binfile}
|
||||
|
||||
#exit and cleanup
|
||||
gdb_exit
|
||||
test_breakpoints
|
||||
test_assign
|
||||
test_whereis
|
||||
gdb_test "file average.c:1" "1\[ \t\]+/. This is a sample program.*"
|
||||
test_func
|
||||
|
||||
set GDBFLAGS $saved_gdbflags
|
||||
eval proc gdb_file_cmd {$old_gdb_file_cmd_args} {$old_gdb_file_cmd_body}
|
||||
#exit and cleanup
|
||||
gdb_exit
|
||||
}
|
||||
}
|
||||
|
||||
return 0
|
||||
|
|
|
@ -7200,5 +7200,48 @@ proc hex_in_list { val hexlist } {
|
|||
return [expr $index != -1]
|
||||
}
|
||||
|
||||
# Override proc NAME to proc OVERRIDE for the duration of the execution of
|
||||
# BODY.
|
||||
|
||||
proc with_override { name override body } {
|
||||
# Implementation note: It's possible to implement the override using
|
||||
# rename, like this:
|
||||
# rename $name save_$name
|
||||
# rename $override $name
|
||||
# set code [catch {uplevel 1 $body} result]
|
||||
# rename $name $override
|
||||
# rename save_$name $name
|
||||
# but there are two issues here:
|
||||
# - the save_$name might clash with an existing proc
|
||||
# - the override is no longer available under its original name during
|
||||
# the override
|
||||
# So, we use this more elaborate but cleaner mechanism.
|
||||
|
||||
# Save the old proc.
|
||||
set old_args [info args $name]
|
||||
set old_body [info body $name]
|
||||
|
||||
# Install the override.
|
||||
set new_args [info args $override]
|
||||
set new_body [info body $override]
|
||||
eval proc $name {$new_args} {$new_body}
|
||||
|
||||
# Execute body.
|
||||
set code [catch {uplevel 1 $body} result]
|
||||
|
||||
# Restore old proc.
|
||||
eval proc $name {$old_args} {$old_body}
|
||||
|
||||
# Return as appropriate.
|
||||
if { $code == 1 } {
|
||||
global errorInfo errorCode
|
||||
return -code error -errorinfo $errorInfo -errorcode $errorCode $result
|
||||
} elseif { $code > 1 } {
|
||||
return -code $code $result
|
||||
}
|
||||
|
||||
return $result
|
||||
}
|
||||
|
||||
# Always load compatibility stuff.
|
||||
load_lib future.exp
|
||||
|
|
Loading…
Reference in New Issue