From: Tom Tromey Date: Sat, 13 Sep 2025 18:49:06 +0000 (-0600) Subject: Remove uses of "eval" from gdb testsuite X-Git-Url: http://git.ipfire.org/?a=commitdiff_plain;h=a170cec53008729739d7b4bb0faee7d1d3146fc1;p=thirdparty%2Fbinutils-gdb.git 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 --- diff --git a/gdb/testsuite/boards/native-extended-gdbserver.exp b/gdb/testsuite/boards/native-extended-gdbserver.exp index 3299e314058..22d87820905 100644 --- a/gdb/testsuite/boards/native-extended-gdbserver.exp +++ b/gdb/testsuite/boards/native-extended-gdbserver.exp @@ -58,7 +58,7 @@ proc mi_gdb_start { args } { global gdbserver_reconnect_p # Spawn GDB. - set res [eval extended_gdbserver_mi_gdb_start $args] + set res [extended_gdbserver_mi_gdb_start {*}$args] if { $res } { return $res } diff --git a/gdb/testsuite/gdb.ada/unchecked_union.exp b/gdb/testsuite/gdb.ada/unchecked_union.exp index 89c05931768..5d29e28b4e5 100644 --- a/gdb/testsuite/gdb.ada/unchecked_union.exp +++ b/gdb/testsuite/gdb.ada/unchecked_union.exp @@ -26,7 +26,7 @@ proc multi_line_string {str} { foreach line [split $str \n] { lappend result [string_to_regexp $line] } - return [eval multi_line $result] + return [multi_line {*}$result] } set inner_string { case ? is diff --git a/gdb/testsuite/gdb.base/attach-twice.exp b/gdb/testsuite/gdb.base/attach-twice.exp index 3d742983962..63205e276d3 100644 --- a/gdb/testsuite/gdb.base/attach-twice.exp +++ b/gdb/testsuite/gdb.base/attach-twice.exp @@ -45,6 +45,6 @@ gdb_test_multiple "attach $testpid" $test { } if {$parentpid != 0} { - eval exec kill -9 $parentpid + exec kill -9 $parentpid } kill_wait_spawned_process $test_spawn_id diff --git a/gdb/testsuite/gdb.base/consecutive.exp b/gdb/testsuite/gdb.base/consecutive.exp index e73b3c3ffc3..fa58a8f02fb 100644 --- a/gdb/testsuite/gdb.base/consecutive.exp +++ b/gdb/testsuite/gdb.base/consecutive.exp @@ -54,7 +54,7 @@ gdb_test "break \*$bp_addr" "Breakpoint $decimal at $bp_addr: file .*" \ gdb_test_multiple "step" "stopped at bp, 2nd instr" { -re -wrap "Breakpoint $decimal, ($hex) in foo.*" { 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" } else { 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] if {!$stop_addr_is_stmt} { 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" } else { fail "stopped at bp, 2nd instr (wrong address)" diff --git a/gdb/testsuite/gdb.base/ctf-ptype.exp b/gdb/testsuite/gdb.base/ctf-ptype.exp index 3f9023f3c71..6d55cb26145 100644 --- a/gdb/testsuite/gdb.base/ctf-ptype.exp +++ b/gdb/testsuite/gdb.base/ctf-ptype.exp @@ -234,11 +234,10 @@ proc ptype_maybe_prototyped { id prototyped plain { overprototyped "NO-MATCH" } # Turn the arguments, which are literal strings, into # regular expressions by quoting any special characters they contain. foreach var { prototyped plain overprototyped } { - eval "set val \$$var" - regsub -all "\[\]\[*()\]" $val "\\\\&" val + set val [string_to_regexp [set $var]] regsub -all "short int" $val "short( int)?" val regsub -all "long int" $val "long( int)?" val - eval "set $var \$val" + set $var $val } gdb_test_multiple "ptype $id" "ptype $id" { diff --git a/gdb/testsuite/gdb.base/ending-run.exp b/gdb/testsuite/gdb.base/ending-run.exp index 022ac28f04f..0b5eadf806c 100644 --- a/gdb/testsuite/gdb.base/ending-run.exp +++ b/gdb/testsuite/gdb.base/ending-run.exp @@ -224,7 +224,7 @@ set program_in_exit 0 if {!$use_gdb_stub && (! [target_info exists use_cygmon] || ! [target_info use_cygmon])} { global program_exited - if {[eval expr $program_exited == 0]} { + if {$program_exited == 0} { gdb_test_multiple "n" "step to end of run" { -re "$inferior_exited_re normally.*$gdb_prompt $" { # If we actually have debug info for the start function, diff --git a/gdb/testsuite/gdb.base/gdbinit-history.exp b/gdb/testsuite/gdb.base/gdbinit-history.exp index 48aae6b1766..11a4a23c528 100644 --- a/gdb/testsuite/gdb.base/gdbinit-history.exp +++ b/gdb/testsuite/gdb.base/gdbinit-history.exp @@ -141,7 +141,7 @@ proc check_history { hist } { if { [llength $hist_lines] == 1 } { set pattern [lindex $hist_lines 0] } else { - set pattern [eval multi_line $hist_lines] + set pattern [multi_line {*}$hist_lines] } # Check the history. diff --git a/gdb/testsuite/gdb.base/ptype.exp b/gdb/testsuite/gdb.base/ptype.exp index 6971f4c8ca7..04d2d2b0234 100644 --- a/gdb/testsuite/gdb.base/ptype.exp +++ b/gdb/testsuite/gdb.base/ptype.exp @@ -528,11 +528,10 @@ proc ptype_maybe_prototyped { id prototyped plain { overprototyped "NO-MATCH" } # Turn the arguments, which are literal strings, into # regular expressions by quoting any special characters they contain. foreach var { prototyped plain overprototyped } { - eval "set val \$$var" - regsub -all "\[\]\[*()\]" $val "\\\\&" val + set val [string_to_regexp [set $var]] regsub -all "short int" $val "short( int)?" val regsub -all "long int" $val "long( int)?" val - eval "set $var \$val" + set $var $val } gdb_test_multiple "ptype $id" "ptype $id" { diff --git a/gdb/testsuite/gdb.base/style.exp b/gdb/testsuite/gdb.base/style.exp index 6ab16ca9e01..92b508520de 100644 --- a/gdb/testsuite/gdb.base/style.exp +++ b/gdb/testsuite/gdb.base/style.exp @@ -50,7 +50,7 @@ proc clean_restart_and_disable { prefix args } { global currently_disabled_style with_test_prefix "$prefix" { - eval "clean_restart $args" + clean_restart {*}$args if { $currently_disabled_style != "" } { set st $currently_disabled_style diff --git a/gdb/testsuite/gdb.linespec/ls-errs.exp b/gdb/testsuite/gdb.linespec/ls-errs.exp index 303fd9f5ebb..fc003ea4d8c 100644 --- a/gdb/testsuite/gdb.linespec/ls-errs.exp +++ b/gdb/testsuite/gdb.linespec/ls-errs.exp @@ -89,9 +89,8 @@ proc do_test {lang} { proc test_break {linespec msg_id args} { global error_messages - gdb_test "break $linespec" [string_to_regexp \ - [eval format \$error_messages($msg_id) \ - $args]] \ + gdb_test "break $linespec" \ + [string_to_regexp [format $error_messages($msg_id) {*}$args]] \ "'break $linespec'" } diff --git a/gdb/testsuite/gdb.mi/mi-break.exp b/gdb/testsuite/gdb.mi/mi-break.exp index 2a212c37496..cb7c14b4886 100644 --- a/gdb/testsuite/gdb.mi/mi-break.exp +++ b/gdb/testsuite/gdb.mi/mi-break.exp @@ -346,7 +346,7 @@ proc_with_prefix test_forced_conditions {} { set loc [mi_make_breakpoint_loc -enabled "N"] 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" \ "${warning}\\^done,$bp" \ diff --git a/gdb/testsuite/gdb.opt/inline-break.exp b/gdb/testsuite/gdb.opt/inline-break.exp index 7ecb3fadfba..0805f693e69 100644 --- a/gdb/testsuite/gdb.opt/inline-break.exp +++ b/gdb/testsuite/gdb.opt/inline-break.exp @@ -209,7 +209,7 @@ foreach_with_prefix cmd [list "break" "tbreak"] { # that we actually stop where we think we should. for {set i 1} {$i < 4} {incr i} { foreach inline {"not_inline" "inline"} { - eval gdb_breakpoint "${inline}_func$i" $break_flags + gdb_breakpoint "${inline}_func$i" {*}$break_flags } } diff --git a/gdb/testsuite/gdb.reverse/consecutive-precsave.exp b/gdb/testsuite/gdb.reverse/consecutive-precsave.exp index 2cb139d47bf..3ccff48296b 100644 --- a/gdb/testsuite/gdb.reverse/consecutive-precsave.exp +++ b/gdb/testsuite/gdb.reverse/consecutive-precsave.exp @@ -79,7 +79,7 @@ set testmsg "stopped at bp, 2nd instr" gdb_test_multiple "step" $testmsg { -re -wrap "Breakpoint $decimal, ($hex) in foo.*" { 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" } else { 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] if { ! $stop_addr_is_stmt } { 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" } else { 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" { -re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" { set stop_addr $expect_out(1,string) - if {[eval expr "$foo1_addr == $stop_addr"]} { + if {$foo1_addr == $stop_addr} { pass "$test_msg" } else { fail "$test_msg (wrong address)" diff --git a/gdb/testsuite/gdb.reverse/consecutive-reverse.exp b/gdb/testsuite/gdb.reverse/consecutive-reverse.exp index 27f2b72c531..8996d792ed8 100644 --- a/gdb/testsuite/gdb.reverse/consecutive-reverse.exp +++ b/gdb/testsuite/gdb.reverse/consecutive-reverse.exp @@ -61,7 +61,7 @@ set testmsg "stopped at bp, 2nd instr" gdb_test_multiple "step" $testmsg { -re -wrap "Breakpoint $decimal, ($hex) in foo.*" { 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" } else { 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] if { ! $stop_addr_is_stmt } { 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" } else { 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" { -re "Breakpoint $decimal, ($hex) in foo.*$gdb_prompt $" { set stop_addr $expect_out(1,string) - if {[eval expr "$foo1_addr == $stop_addr"]} { + if {$foo1_addr == $stop_addr} { pass "$test_msg" } else { fail "$test_msg (wrong address)" diff --git a/gdb/testsuite/gdb.tui/tuiterm.exp b/gdb/testsuite/gdb.tui/tuiterm.exp index ed9478a67d3..a91643eba8b 100644 --- a/gdb/testsuite/gdb.tui/tuiterm.exp +++ b/gdb/testsuite/gdb.tui/tuiterm.exp @@ -807,7 +807,7 @@ proc test_attrs {} { proc run_one_test_small { test_proc_name } { save_vars { env(TERM) stty_init } { 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 } { save_vars { env(TERM) stty_init } { setup_large - eval $test_proc_name + $test_proc_name } } diff --git a/gdb/testsuite/lib/dap-support.exp b/gdb/testsuite/lib/dap-support.exp index d61b1c47f3c..3f0f75ab0ba 100644 --- a/gdb/testsuite/lib/dap-support.exp +++ b/gdb/testsuite/lib/dap-support.exp @@ -443,7 +443,7 @@ proc dap_search_output {name rx events} { # key/value pairs given in ARGS. NAME is used as the test name. proc dap_match_values {name d args} { foreach {key value} $args { - if {[eval dict get [list $d] $key] != $value} { + if {[dict get $d {*}$key] != $value} { fail "$name (checking $key)" return "" } @@ -494,7 +494,7 @@ proc dap_wait_for_event_and_check {name type args} { set result [_dap_wait_for_event $type] set event [lindex $result 0] - eval dap_match_values [list $name $event] $args + dap_match_values $name $event {*}$args return $result } diff --git a/gdb/testsuite/lib/dwarf.exp b/gdb/testsuite/lib/dwarf.exp index 3a182c22ea0..c19240bfc2e 100644 --- a/gdb/testsuite/lib/dwarf.exp +++ b/gdb/testsuite/lib/dwarf.exp @@ -1094,7 +1094,7 @@ namespace eval Dwarf { if {![info exists _deferred_output($_defer)]} { set _deferred_output($_defer) "" - eval _section $section_spec + _section {*}$section_spec } uplevel $body diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 930462f63fa..3c19f7110ea 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -358,7 +358,7 @@ proc default_gdb_version {} { global 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"] @@ -8266,7 +8266,7 @@ set temp [interp create] if { [interp eval $temp "info procs ::unknown"] != "" } { set old_args [interp eval $temp "info args ::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 unset temp @@ -8301,11 +8301,11 @@ proc gdb_finish { } { gdb_exit if { [llength $cleanfiles_target] > 0 } { - eval remote_file target delete $cleanfiles_target + remote_file target delete {*}$cleanfiles_target set cleanfiles_target {} } if { [llength $cleanfiles_host] > 0 } { - eval remote_file host delete $cleanfiles_host + remote_file host delete {*}$cleanfiles_host set cleanfiles_host {} } @@ -9251,7 +9251,7 @@ proc build_executable { testname executable {sources ""} {options {debug}} } { 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. @@ -9306,7 +9306,7 @@ proc clean_restart {{executable ""}} { # Returns 0 on success, non-zero on failure. proc prepare_for_testing_full {testname args} { foreach spec $args { - if {[eval build_executable_from_specs [list $testname] $spec] == -1} { + if {[build_executable_from_specs $testname {*}$spec] == -1} { return -1 } set executable [lindex $spec 0] @@ -9563,12 +9563,12 @@ proc relative_filename {root full} { set len [llength $root_split] - if {[eval file join $root_split] - != [eval file join [lrange $full_split 0 [expr {$len - 1}]]]} { + if {[file join {*}$root_split] + != [file join {*}[lrange $full_split 0 [expr {$len - 1}]]]} { 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. @@ -9912,7 +9912,7 @@ proc run_on_host { test program args } { if {[llength $args] > 1 && [lindex $args 1] == ""} { 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" set status [lindex $result 0] set output [lindex $result 1] @@ -10716,14 +10716,14 @@ proc with_override { name override body } { # Install the override. set new_args [info_args_with_defaults $override] set new_body [info body $override] - eval proc $name {$new_args} {$new_body} + proc $name $new_args $new_body # Execute body. set code [catch {uplevel 1 $body} result] # Restore old proc if it existed on entry, else delete it. if { $existed } { - eval proc $name {$old_args} {$old_body} + proc $name $old_args $old_body } else { rename $name "" } diff --git a/gdb/testsuite/lib/gdbserver-support.exp b/gdb/testsuite/lib/gdbserver-support.exp index 23892068c97..6ff00baedeb 100644 --- a/gdb/testsuite/lib/gdbserver-support.exp +++ b/gdb/testsuite/lib/gdbserver-support.exp @@ -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. 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] } diff --git a/gdb/testsuite/lib/mi-support.exp b/gdb/testsuite/lib/mi-support.exp index a3ae648c63b..fcbcddcdf2f 100644 --- a/gdb/testsuite/lib/mi-support.exp +++ b/gdb/testsuite/lib/mi-support.exp @@ -340,7 +340,7 @@ proc default_mi_gdb_start { { flags {} } } { # baseboard file. # 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 @@ -1010,14 +1010,14 @@ proc mi_run_cmd_full {use_mi_command args} { # -exec-continue, as appropriate. ARGS are passed verbatim to # mi_run_cmd_full. 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 # 'continue', as appropriate. ARGS are passed verbatim to # mi_run_cmd_full. 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. @@ -1397,7 +1397,7 @@ proc mi_continue_to {func} { # returns the breakpoint regexp from that procedure. 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 return $bp } @@ -1406,7 +1406,7 @@ proc mi_create_breakpoint {location test args} { # locations using mi_make_breakpoint_multi instead. 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 return $bp } @@ -1414,7 +1414,7 @@ proc mi_create_breakpoint_multi {location test args} { # Like mi_create_breakpoint, but creates a pending breakpoint. 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 return $bp } @@ -2686,7 +2686,7 @@ proc mi_make_info_frame_regexp {args} { proc mi_info_frame { test args } { 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" if {$frame ne ""} { diff --git a/gdb/testsuite/lib/trace-support.exp b/gdb/testsuite/lib/trace-support.exp index a8d0699ce54..8543de32278 100644 --- a/gdb/testsuite/lib/trace-support.exp +++ b/gdb/testsuite/lib/trace-support.exp @@ -219,14 +219,14 @@ proc gdb_trace_setactions_command { actions_command testname tracepoint args } { # gdb_trace_setactions_command. # 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 # gdb_trace_setactions_command. # proc gdb_trace_setcommands { testname tracepoint args } { - eval gdb_trace_setactions_command "commands" {$testname} {$tracepoint} $args + gdb_trace_setactions_command "commands" $testname $tracepoint {*}$args } # diff --git a/gdb/testsuite/lib/tuiterm.exp b/gdb/testsuite/lib/tuiterm.exp index 97017c779e6..68fd6777b7c 100644 --- a/gdb/testsuite/lib/tuiterm.exp +++ b/gdb/testsuite/lib/tuiterm.exp @@ -1046,7 +1046,7 @@ proc Term::accept_gdb_output { {warn 1} } { scan $expect_out(1,string) %c val set hexval [format "%02x" $val] set cmd $expect_out(2,string) - eval _esc_0x${hexval}_$cmd + _esc_0x${hexval}_$cmd } -re "^(\[=>\])" { scan $expect_out(1,string) %c val @@ -1081,13 +1081,13 @@ proc Term::accept_gdb_output { {warn 1} } { -re "^($re_csi_cmd)" { set cmd $expect_out(1,string) _log "wait_for: _csi_$cmd" - eval _csi_$cmd + _csi_$cmd } -re "^($re_csi_args*)($re_csi_cmd)" { set params [split $expect_out(1,string) ";"] set cmd $expect_out(2,string) _log "wait_for: _csi_$cmd <<<$params>>>" - eval _csi_$cmd $params + _csi_$cmd {*}$params } -re "^($re_csi_prefix?)($re_csi_args*)($re_csi_cmd)" { set prefix $expect_out(1,string) @@ -1096,7 +1096,7 @@ proc Term::accept_gdb_output { {warn 1} } { scan $prefix %c val set hexval [format "%02x" $val] _log "wait_for: _csi_0x${hexval}_$cmd <<<$expect_out(1,string)>>>" - eval _csi_0x${hexval}_$cmd $params + _csi_0x${hexval}_$cmd {*}$params } timeout {