mirror of
https://github.com/bminor/binutils-gdb.git
synced 2025-12-26 09:08:59 +00:00
Remove uses of "eval" from gdb testsuite
This patch removes a lot of uses of the Tcl "eval" proc from the gdb
test suite. In most cases the {*} "splat" expansion is used instead.
A few uses of eval remain, primarily ones that were more complicated
to untangle.
In a couple of tests I also replaced some ad hoc code with
string_to_regexp.
Tested on x86-64 Fedora 40.
Reviewed-By: Tom de Vries <tdevries@suse.de>
This commit is contained in:
@@ -58,7 +58,7 @@ proc mi_gdb_start { args } {
|
|||||||
global gdbserver_reconnect_p
|
global gdbserver_reconnect_p
|
||||||
|
|
||||||
# Spawn GDB.
|
# Spawn GDB.
|
||||||
set res [eval extended_gdbserver_mi_gdb_start $args]
|
set res [extended_gdbserver_mi_gdb_start {*}$args]
|
||||||
if { $res } {
|
if { $res } {
|
||||||
return $res
|
return $res
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -26,7 +26,7 @@ proc multi_line_string {str} {
|
|||||||
foreach line [split $str \n] {
|
foreach line [split $str \n] {
|
||||||
lappend result [string_to_regexp $line]
|
lappend result [string_to_regexp $line]
|
||||||
}
|
}
|
||||||
return [eval multi_line $result]
|
return [multi_line {*}$result]
|
||||||
}
|
}
|
||||||
|
|
||||||
set inner_string { case ? is
|
set inner_string { case ? is
|
||||||
|
|||||||
@@ -45,6 +45,6 @@ gdb_test_multiple "attach $testpid" $test {
|
|||||||
}
|
}
|
||||||
|
|
||||||
if {$parentpid != 0} {
|
if {$parentpid != 0} {
|
||||||
eval exec kill -9 $parentpid
|
exec kill -9 $parentpid
|
||||||
}
|
}
|
||||||
kill_wait_spawned_process $test_spawn_id
|
kill_wait_spawned_process $test_spawn_id
|
||||||
|
|||||||
@@ -54,7 +54,7 @@ gdb_test "break \*$bp_addr" "Breakpoint $decimal at $bp_addr: file .*" \
|
|||||||
gdb_test_multiple "step" "stopped at bp, 2nd instr" {
|
gdb_test_multiple "step" "stopped at bp, 2nd instr" {
|
||||||
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
||||||
set stop_addr $expect_out(1,string)
|
set stop_addr $expect_out(1,string)
|
||||||
if {[eval expr "$bp_addr == $stop_addr"]} {
|
if {$bp_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
@@ -65,7 +65,7 @@ gdb_test_multiple "step" "stopped at bp, 2nd instr" {
|
|||||||
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
||||||
if {!$stop_addr_is_stmt} {
|
if {!$stop_addr_is_stmt} {
|
||||||
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
||||||
} elseif {[eval expr "$bp_addr == $stop_addr"]} {
|
} elseif {$bp_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
|
|||||||
@@ -234,11 +234,10 @@ proc ptype_maybe_prototyped { id prototyped plain { overprototyped "NO-MATCH" }
|
|||||||
# Turn the arguments, which are literal strings, into
|
# Turn the arguments, which are literal strings, into
|
||||||
# regular expressions by quoting any special characters they contain.
|
# regular expressions by quoting any special characters they contain.
|
||||||
foreach var { prototyped plain overprototyped } {
|
foreach var { prototyped plain overprototyped } {
|
||||||
eval "set val \$$var"
|
set val [string_to_regexp [set $var]]
|
||||||
regsub -all "\[\]\[*()\]" $val "\\\\&" val
|
|
||||||
regsub -all "short int" $val "short( int)?" val
|
regsub -all "short int" $val "short( int)?" val
|
||||||
regsub -all "long int" $val "long( int)?" val
|
regsub -all "long int" $val "long( int)?" val
|
||||||
eval "set $var \$val"
|
set $var $val
|
||||||
}
|
}
|
||||||
|
|
||||||
gdb_test_multiple "ptype $id" "ptype $id" {
|
gdb_test_multiple "ptype $id" "ptype $id" {
|
||||||
|
|||||||
@@ -224,7 +224,7 @@ set program_in_exit 0
|
|||||||
if {!$use_gdb_stub
|
if {!$use_gdb_stub
|
||||||
&& (! [target_info exists use_cygmon] || ! [target_info use_cygmon])} {
|
&& (! [target_info exists use_cygmon] || ! [target_info use_cygmon])} {
|
||||||
global program_exited
|
global program_exited
|
||||||
if {[eval expr $program_exited == 0]} {
|
if {$program_exited == 0} {
|
||||||
gdb_test_multiple "n" "step to end of run" {
|
gdb_test_multiple "n" "step to end of run" {
|
||||||
-re "$inferior_exited_re normally.*$gdb_prompt $" {
|
-re "$inferior_exited_re normally.*$gdb_prompt $" {
|
||||||
# If we actually have debug info for the start function,
|
# If we actually have debug info for the start function,
|
||||||
|
|||||||
@@ -141,7 +141,7 @@ proc check_history { hist } {
|
|||||||
if { [llength $hist_lines] == 1 } {
|
if { [llength $hist_lines] == 1 } {
|
||||||
set pattern [lindex $hist_lines 0]
|
set pattern [lindex $hist_lines 0]
|
||||||
} else {
|
} else {
|
||||||
set pattern [eval multi_line $hist_lines]
|
set pattern [multi_line {*}$hist_lines]
|
||||||
}
|
}
|
||||||
|
|
||||||
# Check the history.
|
# Check the history.
|
||||||
|
|||||||
@@ -528,11 +528,10 @@ proc ptype_maybe_prototyped { id prototyped plain { overprototyped "NO-MATCH" }
|
|||||||
# Turn the arguments, which are literal strings, into
|
# Turn the arguments, which are literal strings, into
|
||||||
# regular expressions by quoting any special characters they contain.
|
# regular expressions by quoting any special characters they contain.
|
||||||
foreach var { prototyped plain overprototyped } {
|
foreach var { prototyped plain overprototyped } {
|
||||||
eval "set val \$$var"
|
set val [string_to_regexp [set $var]]
|
||||||
regsub -all "\[\]\[*()\]" $val "\\\\&" val
|
|
||||||
regsub -all "short int" $val "short( int)?" val
|
regsub -all "short int" $val "short( int)?" val
|
||||||
regsub -all "long int" $val "long( int)?" val
|
regsub -all "long int" $val "long( int)?" val
|
||||||
eval "set $var \$val"
|
set $var $val
|
||||||
}
|
}
|
||||||
|
|
||||||
gdb_test_multiple "ptype $id" "ptype $id" {
|
gdb_test_multiple "ptype $id" "ptype $id" {
|
||||||
|
|||||||
@@ -50,7 +50,7 @@ proc clean_restart_and_disable { prefix args } {
|
|||||||
global currently_disabled_style
|
global currently_disabled_style
|
||||||
|
|
||||||
with_test_prefix "$prefix" {
|
with_test_prefix "$prefix" {
|
||||||
eval "clean_restart $args"
|
clean_restart {*}$args
|
||||||
|
|
||||||
if { $currently_disabled_style != "" } {
|
if { $currently_disabled_style != "" } {
|
||||||
set st $currently_disabled_style
|
set st $currently_disabled_style
|
||||||
|
|||||||
@@ -89,9 +89,8 @@ proc do_test {lang} {
|
|||||||
proc test_break {linespec msg_id args} {
|
proc test_break {linespec msg_id args} {
|
||||||
global error_messages
|
global error_messages
|
||||||
|
|
||||||
gdb_test "break $linespec" [string_to_regexp \
|
gdb_test "break $linespec" \
|
||||||
[eval format \$error_messages($msg_id) \
|
[string_to_regexp [format $error_messages($msg_id) {*}$args]] \
|
||||||
$args]] \
|
|
||||||
"'break $linespec'"
|
"'break $linespec'"
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -346,7 +346,7 @@ proc_with_prefix test_forced_conditions {} {
|
|||||||
|
|
||||||
set loc [mi_make_breakpoint_loc -enabled "N"]
|
set loc [mi_make_breakpoint_loc -enabled "N"]
|
||||||
set args [list -cond "bad" -locations "\\\[$loc\\\]"]
|
set args [list -cond "bad" -locations "\\\[$loc\\\]"]
|
||||||
set bp [eval mi_make_breakpoint_multi $args]
|
set bp [mi_make_breakpoint_multi {*}$args]
|
||||||
|
|
||||||
mi_gdb_test "-break-insert -c bad --force-condition callme" \
|
mi_gdb_test "-break-insert -c bad --force-condition callme" \
|
||||||
"${warning}\\^done,$bp" \
|
"${warning}\\^done,$bp" \
|
||||||
|
|||||||
@@ -209,7 +209,7 @@ foreach_with_prefix cmd [list "break" "tbreak"] {
|
|||||||
# that we actually stop where we think we should.
|
# that we actually stop where we think we should.
|
||||||
for {set i 1} {$i < 4} {incr i} {
|
for {set i 1} {$i < 4} {incr i} {
|
||||||
foreach inline {"not_inline" "inline"} {
|
foreach inline {"not_inline" "inline"} {
|
||||||
eval gdb_breakpoint "${inline}_func$i" $break_flags
|
gdb_breakpoint "${inline}_func$i" {*}$break_flags
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -79,7 +79,7 @@ set testmsg "stopped at bp, 2nd instr"
|
|||||||
gdb_test_multiple "step" $testmsg {
|
gdb_test_multiple "step" $testmsg {
|
||||||
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
||||||
set stop_addr $expect_out(1,string)
|
set stop_addr $expect_out(1,string)
|
||||||
if {[eval expr "$foo2_addr == $stop_addr"]} {
|
if {$foo2_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
@@ -90,7 +90,7 @@ gdb_test_multiple "step" $testmsg {
|
|||||||
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
||||||
if { ! $stop_addr_is_stmt } {
|
if { ! $stop_addr_is_stmt } {
|
||||||
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
||||||
} elseif {[eval expr "$foo2_addr == $stop_addr"]} {
|
} elseif {$foo2_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
@@ -112,7 +112,7 @@ set test_msg "stopped at bp in reverse, 1st instr"
|
|||||||
gdb_test_multiple "step" "$test_msg" {
|
gdb_test_multiple "step" "$test_msg" {
|
||||||
-re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" {
|
-re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" {
|
||||||
set stop_addr $expect_out(1,string)
|
set stop_addr $expect_out(1,string)
|
||||||
if {[eval expr "$foo1_addr == $stop_addr"]} {
|
if {$foo1_addr == $stop_addr} {
|
||||||
pass "$test_msg"
|
pass "$test_msg"
|
||||||
} else {
|
} else {
|
||||||
fail "$test_msg (wrong address)"
|
fail "$test_msg (wrong address)"
|
||||||
|
|||||||
@@ -61,7 +61,7 @@ set testmsg "stopped at bp, 2nd instr"
|
|||||||
gdb_test_multiple "step" $testmsg {
|
gdb_test_multiple "step" $testmsg {
|
||||||
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
-re -wrap "Breakpoint $decimal, ($hex) in foo.*" {
|
||||||
set stop_addr $expect_out(1,string)
|
set stop_addr $expect_out(1,string)
|
||||||
if {[eval expr "$foo2_addr == $stop_addr"]} {
|
if {$foo2_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
@@ -72,7 +72,7 @@ gdb_test_multiple "step" $testmsg {
|
|||||||
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
set stop_addr_is_stmt [hex_in_list $stop_addr $is_stmt]
|
||||||
if { ! $stop_addr_is_stmt } {
|
if { ! $stop_addr_is_stmt } {
|
||||||
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
fail "stopped at bp, 2nd instr (missing hex prefix)"
|
||||||
} elseif {[eval expr "$foo2_addr == $stop_addr"]} {
|
} elseif {$foo2_addr == $stop_addr} {
|
||||||
pass "stopped at bp, 2nd instr"
|
pass "stopped at bp, 2nd instr"
|
||||||
} else {
|
} else {
|
||||||
fail "stopped at bp, 2nd instr (wrong address)"
|
fail "stopped at bp, 2nd instr (wrong address)"
|
||||||
@@ -94,7 +94,7 @@ set test_msg "stopped at bp in reverse, 1st instr"
|
|||||||
gdb_test_multiple "step" "$test_msg" {
|
gdb_test_multiple "step" "$test_msg" {
|
||||||
-re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" {
|
-re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" {
|
||||||
set stop_addr $expect_out(1,string)
|
set stop_addr $expect_out(1,string)
|
||||||
if {[eval expr "$foo1_addr == $stop_addr"]} {
|
if {$foo1_addr == $stop_addr} {
|
||||||
pass "$test_msg"
|
pass "$test_msg"
|
||||||
} else {
|
} else {
|
||||||
fail "$test_msg (wrong address)"
|
fail "$test_msg (wrong address)"
|
||||||
|
|||||||
@@ -807,7 +807,7 @@ proc test_attrs {} {
|
|||||||
proc run_one_test_small { test_proc_name } {
|
proc run_one_test_small { test_proc_name } {
|
||||||
save_vars { env(TERM) stty_init } {
|
save_vars { env(TERM) stty_init } {
|
||||||
setup_small
|
setup_small
|
||||||
eval $test_proc_name
|
$test_proc_name
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -816,7 +816,7 @@ proc run_one_test_small { test_proc_name } {
|
|||||||
proc run_one_test_large { test_proc_name } {
|
proc run_one_test_large { test_proc_name } {
|
||||||
save_vars { env(TERM) stty_init } {
|
save_vars { env(TERM) stty_init } {
|
||||||
setup_large
|
setup_large
|
||||||
eval $test_proc_name
|
$test_proc_name
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -443,7 +443,7 @@ proc dap_search_output {name rx events} {
|
|||||||
# key/value pairs given in ARGS. NAME is used as the test name.
|
# key/value pairs given in ARGS. NAME is used as the test name.
|
||||||
proc dap_match_values {name d args} {
|
proc dap_match_values {name d args} {
|
||||||
foreach {key value} $args {
|
foreach {key value} $args {
|
||||||
if {[eval dict get [list $d] $key] != $value} {
|
if {[dict get $d {*}$key] != $value} {
|
||||||
fail "$name (checking $key)"
|
fail "$name (checking $key)"
|
||||||
return ""
|
return ""
|
||||||
}
|
}
|
||||||
@@ -494,7 +494,7 @@ proc dap_wait_for_event_and_check {name type args} {
|
|||||||
|
|
||||||
set result [_dap_wait_for_event $type]
|
set result [_dap_wait_for_event $type]
|
||||||
set event [lindex $result 0]
|
set event [lindex $result 0]
|
||||||
eval dap_match_values [list $name $event] $args
|
dap_match_values $name $event {*}$args
|
||||||
|
|
||||||
return $result
|
return $result
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -1094,7 +1094,7 @@ namespace eval Dwarf {
|
|||||||
|
|
||||||
if {![info exists _deferred_output($_defer)]} {
|
if {![info exists _deferred_output($_defer)]} {
|
||||||
set _deferred_output($_defer) ""
|
set _deferred_output($_defer) ""
|
||||||
eval _section $section_spec
|
_section {*}$section_spec
|
||||||
}
|
}
|
||||||
|
|
||||||
uplevel $body
|
uplevel $body
|
||||||
|
|||||||
@@ -358,7 +358,7 @@ proc default_gdb_version {} {
|
|||||||
global inotify_pid
|
global inotify_pid
|
||||||
|
|
||||||
if {[info exists inotify_pid]} {
|
if {[info exists inotify_pid]} {
|
||||||
eval exec kill $inotify_pid
|
exec kill $inotify_pid
|
||||||
}
|
}
|
||||||
|
|
||||||
set output [remote_exec host "$GDB $INTERNAL_GDBFLAGS --version"]
|
set output [remote_exec host "$GDB $INTERNAL_GDBFLAGS --version"]
|
||||||
@@ -8266,7 +8266,7 @@ set temp [interp create]
|
|||||||
if { [interp eval $temp "info procs ::unknown"] != "" } {
|
if { [interp eval $temp "info procs ::unknown"] != "" } {
|
||||||
set old_args [interp eval $temp "info args ::unknown"]
|
set old_args [interp eval $temp "info args ::unknown"]
|
||||||
set old_body [interp eval $temp "info body ::unknown"]
|
set old_body [interp eval $temp "info body ::unknown"]
|
||||||
eval proc gdb_tcl_unknown {$old_args} {$old_body}
|
proc gdb_tcl_unknown $old_args $old_body
|
||||||
}
|
}
|
||||||
interp delete $temp
|
interp delete $temp
|
||||||
unset temp
|
unset temp
|
||||||
@@ -8301,11 +8301,11 @@ proc gdb_finish { } {
|
|||||||
gdb_exit
|
gdb_exit
|
||||||
|
|
||||||
if { [llength $cleanfiles_target] > 0 } {
|
if { [llength $cleanfiles_target] > 0 } {
|
||||||
eval remote_file target delete $cleanfiles_target
|
remote_file target delete {*}$cleanfiles_target
|
||||||
set cleanfiles_target {}
|
set cleanfiles_target {}
|
||||||
}
|
}
|
||||||
if { [llength $cleanfiles_host] > 0 } {
|
if { [llength $cleanfiles_host] > 0 } {
|
||||||
eval remote_file host delete $cleanfiles_host
|
remote_file host delete {*}$cleanfiles_host
|
||||||
set cleanfiles_host {}
|
set cleanfiles_host {}
|
||||||
}
|
}
|
||||||
|
|
||||||
@@ -9251,7 +9251,7 @@ proc build_executable { testname executable {sources ""} {options {debug}} } {
|
|||||||
lappend arglist $source $options
|
lappend arglist $source $options
|
||||||
}
|
}
|
||||||
|
|
||||||
return [eval build_executable_from_specs $arglist]
|
return [build_executable_from_specs {*}$arglist]
|
||||||
}
|
}
|
||||||
|
|
||||||
# Starts fresh GDB binary and loads an optional executable into GDB.
|
# Starts fresh GDB binary and loads an optional executable into GDB.
|
||||||
@@ -9306,7 +9306,7 @@ proc clean_restart {{executable ""}} {
|
|||||||
# Returns 0 on success, non-zero on failure.
|
# Returns 0 on success, non-zero on failure.
|
||||||
proc prepare_for_testing_full {testname args} {
|
proc prepare_for_testing_full {testname args} {
|
||||||
foreach spec $args {
|
foreach spec $args {
|
||||||
if {[eval build_executable_from_specs [list $testname] $spec] == -1} {
|
if {[build_executable_from_specs $testname {*}$spec] == -1} {
|
||||||
return -1
|
return -1
|
||||||
}
|
}
|
||||||
set executable [lindex $spec 0]
|
set executable [lindex $spec 0]
|
||||||
@@ -9563,12 +9563,12 @@ proc relative_filename {root full} {
|
|||||||
|
|
||||||
set len [llength $root_split]
|
set len [llength $root_split]
|
||||||
|
|
||||||
if {[eval file join $root_split]
|
if {[file join {*}$root_split]
|
||||||
!= [eval file join [lrange $full_split 0 [expr {$len - 1}]]]} {
|
!= [file join {*}[lrange $full_split 0 [expr {$len - 1}]]]} {
|
||||||
error "$full not a subdir of $root"
|
error "$full not a subdir of $root"
|
||||||
}
|
}
|
||||||
|
|
||||||
return [eval file join [lrange $full_split $len end]]
|
return [file join {*}[lrange $full_split $len end]]
|
||||||
}
|
}
|
||||||
|
|
||||||
# If GDB_PARALLEL exists, then set up the parallel-mode directories.
|
# If GDB_PARALLEL exists, then set up the parallel-mode directories.
|
||||||
@@ -9912,7 +9912,7 @@ proc run_on_host { test program args } {
|
|||||||
if {[llength $args] > 1 && [lindex $args 1] == ""} {
|
if {[llength $args] > 1 && [lindex $args 1] == ""} {
|
||||||
set args [lreplace $args 1 1 "/dev/null"]
|
set args [lreplace $args 1 1 "/dev/null"]
|
||||||
}
|
}
|
||||||
set result [eval remote_exec host [list $program] $args]
|
set result [remote_exec host $program {*}$args]
|
||||||
verbose "result is $result"
|
verbose "result is $result"
|
||||||
set status [lindex $result 0]
|
set status [lindex $result 0]
|
||||||
set output [lindex $result 1]
|
set output [lindex $result 1]
|
||||||
@@ -10716,14 +10716,14 @@ proc with_override { name override body } {
|
|||||||
# Install the override.
|
# Install the override.
|
||||||
set new_args [info_args_with_defaults $override]
|
set new_args [info_args_with_defaults $override]
|
||||||
set new_body [info body $override]
|
set new_body [info body $override]
|
||||||
eval proc $name {$new_args} {$new_body}
|
proc $name $new_args $new_body
|
||||||
|
|
||||||
# Execute body.
|
# Execute body.
|
||||||
set code [catch {uplevel 1 $body} result]
|
set code [catch {uplevel 1 $body} result]
|
||||||
|
|
||||||
# Restore old proc if it existed on entry, else delete it.
|
# Restore old proc if it existed on entry, else delete it.
|
||||||
if { $existed } {
|
if { $existed } {
|
||||||
eval proc $name {$old_args} {$old_body}
|
proc $name $old_args $old_body
|
||||||
} else {
|
} else {
|
||||||
rename $name ""
|
rename $name ""
|
||||||
}
|
}
|
||||||
|
|||||||
@@ -125,7 +125,7 @@ proc gdb_target_cmd_ext { targetname serialport {additional_text ""} } {
|
|||||||
# Like gdb_target_cmd_ext, but returns 0 on success, 1 on failure.
|
# Like gdb_target_cmd_ext, but returns 0 on success, 1 on failure.
|
||||||
|
|
||||||
proc gdb_target_cmd { args } {
|
proc gdb_target_cmd { args } {
|
||||||
set res [eval gdb_target_cmd_ext $args]
|
set res [gdb_target_cmd_ext {*}$args]
|
||||||
return [expr $res == 0 ? 0 : 1]
|
return [expr $res == 0 ? 0 : 1]
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|||||||
@@ -340,7 +340,7 @@ proc default_mi_gdb_start { { flags {} } } {
|
|||||||
# baseboard file.
|
# baseboard file.
|
||||||
#
|
#
|
||||||
proc mi_gdb_start { args } {
|
proc mi_gdb_start { args } {
|
||||||
return [eval default_mi_gdb_start $args]
|
return [default_mi_gdb_start {*}$args]
|
||||||
}
|
}
|
||||||
|
|
||||||
# Many of the tests depend on setting breakpoints at various places and
|
# Many of the tests depend on setting breakpoints at various places and
|
||||||
@@ -1010,14 +1010,14 @@ proc mi_run_cmd_full {use_mi_command args} {
|
|||||||
# -exec-continue, as appropriate. ARGS are passed verbatim to
|
# -exec-continue, as appropriate. ARGS are passed verbatim to
|
||||||
# mi_run_cmd_full.
|
# mi_run_cmd_full.
|
||||||
proc mi_run_cmd {args} {
|
proc mi_run_cmd {args} {
|
||||||
return [eval mi_run_cmd_full 1 $args]
|
return [mi_run_cmd_full 1 {*}$args]
|
||||||
}
|
}
|
||||||
|
|
||||||
# A wrapper for mi_run_cmd_full which uses the CLI commands 'run' and
|
# A wrapper for mi_run_cmd_full which uses the CLI commands 'run' and
|
||||||
# 'continue', as appropriate. ARGS are passed verbatim to
|
# 'continue', as appropriate. ARGS are passed verbatim to
|
||||||
# mi_run_cmd_full.
|
# mi_run_cmd_full.
|
||||||
proc mi_run_with_cli {args} {
|
proc mi_run_with_cli {args} {
|
||||||
return [eval mi_run_cmd_full 0 $args]
|
return [mi_run_cmd_full 0 {*}$args]
|
||||||
}
|
}
|
||||||
|
|
||||||
# Starts fresh GDB binary and loads an optional executable into GDB.
|
# Starts fresh GDB binary and loads an optional executable into GDB.
|
||||||
@@ -1397,7 +1397,7 @@ proc mi_continue_to {func} {
|
|||||||
# returns the breakpoint regexp from that procedure.
|
# returns the breakpoint regexp from that procedure.
|
||||||
|
|
||||||
proc mi_create_breakpoint {location test args} {
|
proc mi_create_breakpoint {location test args} {
|
||||||
set bp [eval mi_make_breakpoint $args]
|
set bp [mi_make_breakpoint {*}$args]
|
||||||
mi_gdb_test "222-break-insert $location" "222\\^done,$bp" $test
|
mi_gdb_test "222-break-insert $location" "222\\^done,$bp" $test
|
||||||
return $bp
|
return $bp
|
||||||
}
|
}
|
||||||
@@ -1406,7 +1406,7 @@ proc mi_create_breakpoint {location test args} {
|
|||||||
# locations using mi_make_breakpoint_multi instead.
|
# locations using mi_make_breakpoint_multi instead.
|
||||||
|
|
||||||
proc mi_create_breakpoint_multi {location test args} {
|
proc mi_create_breakpoint_multi {location test args} {
|
||||||
set bp [eval mi_make_breakpoint_multi $args]
|
set bp [mi_make_breakpoint_multi {*}$args]
|
||||||
mi_gdb_test "222-break-insert $location" "222\\^done,$bp" $test
|
mi_gdb_test "222-break-insert $location" "222\\^done,$bp" $test
|
||||||
return $bp
|
return $bp
|
||||||
}
|
}
|
||||||
@@ -1414,7 +1414,7 @@ proc mi_create_breakpoint_multi {location test args} {
|
|||||||
# Like mi_create_breakpoint, but creates a pending breakpoint.
|
# Like mi_create_breakpoint, but creates a pending breakpoint.
|
||||||
|
|
||||||
proc mi_create_breakpoint_pending {location test args} {
|
proc mi_create_breakpoint_pending {location test args} {
|
||||||
set bp [eval mi_make_breakpoint_pending $args]
|
set bp [mi_make_breakpoint_pending {*}$args]
|
||||||
mi_gdb_test "222-break-insert $location" ".*\r\n222\\^done,$bp" $test
|
mi_gdb_test "222-break-insert $location" ".*\r\n222\\^done,$bp" $test
|
||||||
return $bp
|
return $bp
|
||||||
}
|
}
|
||||||
@@ -2686,7 +2686,7 @@ proc mi_make_info_frame_regexp {args} {
|
|||||||
proc mi_info_frame { test args } {
|
proc mi_info_frame { test args } {
|
||||||
parse_some_args {{frame ""} {thread ""}}
|
parse_some_args {{frame ""} {thread ""}}
|
||||||
|
|
||||||
set re [eval mi_make_info_frame_regexp $args]
|
set re [mi_make_info_frame_regexp {*}$args]
|
||||||
|
|
||||||
set cmd "235-stack-info-frame"
|
set cmd "235-stack-info-frame"
|
||||||
if {$frame ne ""} {
|
if {$frame ne ""} {
|
||||||
|
|||||||
@@ -219,14 +219,14 @@ proc gdb_trace_setactions_command { actions_command testname tracepoint args } {
|
|||||||
# gdb_trace_setactions_command.
|
# gdb_trace_setactions_command.
|
||||||
#
|
#
|
||||||
proc gdb_trace_setactions { testname tracepoint args } {
|
proc gdb_trace_setactions { testname tracepoint args } {
|
||||||
eval gdb_trace_setactions_command "actions" {$testname} {$tracepoint} $args
|
gdb_trace_setactions_command "actions" $testname $tracepoint {*}$args
|
||||||
}
|
}
|
||||||
|
|
||||||
# Define actions for a tracepoint, using the "commands" command. See
|
# Define actions for a tracepoint, using the "commands" command. See
|
||||||
# gdb_trace_setactions_command.
|
# gdb_trace_setactions_command.
|
||||||
#
|
#
|
||||||
proc gdb_trace_setcommands { testname tracepoint args } {
|
proc gdb_trace_setcommands { testname tracepoint args } {
|
||||||
eval gdb_trace_setactions_command "commands" {$testname} {$tracepoint} $args
|
gdb_trace_setactions_command "commands" $testname $tracepoint {*}$args
|
||||||
}
|
}
|
||||||
|
|
||||||
#
|
#
|
||||||
|
|||||||
@@ -1046,7 +1046,7 @@ proc Term::accept_gdb_output { {warn 1} } {
|
|||||||
scan $expect_out(1,string) %c val
|
scan $expect_out(1,string) %c val
|
||||||
set hexval [format "%02x" $val]
|
set hexval [format "%02x" $val]
|
||||||
set cmd $expect_out(2,string)
|
set cmd $expect_out(2,string)
|
||||||
eval _esc_0x${hexval}_$cmd
|
_esc_0x${hexval}_$cmd
|
||||||
}
|
}
|
||||||
-re "^(\[=>\])" {
|
-re "^(\[=>\])" {
|
||||||
scan $expect_out(1,string) %c val
|
scan $expect_out(1,string) %c val
|
||||||
@@ -1081,13 +1081,13 @@ proc Term::accept_gdb_output { {warn 1} } {
|
|||||||
-re "^($re_csi_cmd)" {
|
-re "^($re_csi_cmd)" {
|
||||||
set cmd $expect_out(1,string)
|
set cmd $expect_out(1,string)
|
||||||
_log "wait_for: _csi_$cmd"
|
_log "wait_for: _csi_$cmd"
|
||||||
eval _csi_$cmd
|
_csi_$cmd
|
||||||
}
|
}
|
||||||
-re "^($re_csi_args*)($re_csi_cmd)" {
|
-re "^($re_csi_args*)($re_csi_cmd)" {
|
||||||
set params [split $expect_out(1,string) ";"]
|
set params [split $expect_out(1,string) ";"]
|
||||||
set cmd $expect_out(2,string)
|
set cmd $expect_out(2,string)
|
||||||
_log "wait_for: _csi_$cmd <<<$params>>>"
|
_log "wait_for: _csi_$cmd <<<$params>>>"
|
||||||
eval _csi_$cmd $params
|
_csi_$cmd {*}$params
|
||||||
}
|
}
|
||||||
-re "^($re_csi_prefix?)($re_csi_args*)($re_csi_cmd)" {
|
-re "^($re_csi_prefix?)($re_csi_args*)($re_csi_cmd)" {
|
||||||
set prefix $expect_out(1,string)
|
set prefix $expect_out(1,string)
|
||||||
@@ -1096,7 +1096,7 @@ proc Term::accept_gdb_output { {warn 1} } {
|
|||||||
scan $prefix %c val
|
scan $prefix %c val
|
||||||
set hexval [format "%02x" $val]
|
set hexval [format "%02x" $val]
|
||||||
_log "wait_for: _csi_0x${hexval}_$cmd <<<$expect_out(1,string)>>>"
|
_log "wait_for: _csi_0x${hexval}_$cmd <<<$expect_out(1,string)>>>"
|
||||||
eval _csi_0x${hexval}_$cmd $params
|
_csi_0x${hexval}_$cmd {*}$params
|
||||||
}
|
}
|
||||||
|
|
||||||
timeout {
|
timeout {
|
||||||
|
|||||||
Reference in New Issue
Block a user