From 48a5896cd434969b230d63c7f2e64021cd089fd6 Mon Sep 17 00:00:00 2001 From: Tom de Vries Date: Sun, 5 Oct 2025 22:50:10 +0200 Subject: [PATCH] [gdb/testsuite, tclint] Fix lib/gdb.exp --- gdb/tclint.toml | 1 - gdb/testsuite/lib/gdb.exp | 353 ++++++++++++++++++++------------------ 2 files changed, 182 insertions(+), 172 deletions(-) diff --git a/gdb/tclint.toml b/gdb/tclint.toml index 8e8558e95d4..92b8d3dabc8 100644 --- a/gdb/tclint.toml +++ b/gdb/tclint.toml @@ -33,7 +33,6 @@ exclude = [ # TODO: "gdb/testsuite/boards", "gdb/testsuite/config", -"gdb/testsuite/lib/gdb.exp", # IGNORE (document reason in trailing comment): "gdb/testsuite/gdb.stabs", # To be removed. "gdb/testsuite/lib/ton.tcl", # Imported. diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 797591801b3..e07aab4cdd8 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -136,7 +136,7 @@ proc load_lib { file } { set known_globals($varname) 1 } - set code [catch "saved_load_lib $file" result] + set code [catch {saved_load_lib $file} result] foreach varname [info globals] { if { ![info exists known_globals($varname)] } { @@ -175,11 +175,11 @@ global GDB_DATA_DIRECTORY # so input/output is done on gdbserver's tty. global inferior_spawn_id -if [info exists TOOL_EXECUTABLE] { +if {[info exists TOOL_EXECUTABLE]} { set GDB $TOOL_EXECUTABLE } -if ![info exists GDB] { - if ![is_remote host] { +if {![info exists GDB]} { + if {![is_remote host]} { set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]] } else { set GDB [transform gdb] @@ -188,7 +188,7 @@ if ![info exists GDB] { # If the user specifies GDB on the command line, and doesn't # specify GDB_DATA_DIRECTORY, then assume we're testing an # installed GDB, and let it use its own configured data directory. - if ![info exists GDB_DATA_DIRECTORY] { + if {![info exists GDB_DATA_DIRECTORY]} { set GDB_DATA_DIRECTORY "" } } @@ -197,7 +197,7 @@ verbose "using GDB = $GDB" 2 # The data directory the testing GDB will use. By default, assume # we're testing a non-installed GDB in the build directory. Users may # also explicitly override the -data-directory from the command line. -if ![info exists GDB_DATA_DIRECTORY] { +if {![info exists GDB_DATA_DIRECTORY]} { set GDB_DATA_DIRECTORY [file normalize "[pwd]/../data-directory"] } verbose "using GDB_DATA_DIRECTORY = $GDB_DATA_DIRECTORY" 2 @@ -225,7 +225,7 @@ proc has_gcore_script {} { # - append new flags, not overwrite # - restore the original value when done global GDBFLAGS -if ![info exists GDBFLAGS] { +if {![info exists GDBFLAGS]} { set GDBFLAGS "" } verbose "using GDBFLAGS = $GDBFLAGS" 2 @@ -250,7 +250,7 @@ proc append_gdb_data_directory_option {cmdline} { # `-data-directory' points to the data directory, usually in the build # directory. global INTERNAL_GDBFLAGS -if ![info exists INTERNAL_GDBFLAGS] { +if {![info exists INTERNAL_GDBFLAGS]} { set INTERNAL_GDBFLAGS \ [join [list \ "-nw" \ @@ -296,23 +296,23 @@ set pagination_prompt_str \ # A regexp that matches the pagination prompt. set pagination_prompt [string_to_regexp $pagination_prompt_str] -# The variable fullname_syntax_POSIX is a regexp which matches a POSIX -# absolute path ie. /foo/ +# The variable fullname_syntax_POSIX is a regexp which matches a POSIX +# absolute path ie. "/foo/". set fullname_syntax_POSIX {/[^\n]*/} -# The variable fullname_syntax_UNC is a regexp which matches a Windows -# UNC path ie. \\D\foo\ +# The variable fullname_syntax_UNC is a regexp which matches a Windows +# UNC path ie. "\\D\foo\". set fullname_syntax_UNC {\\\\[^\\]+\\[^\n]+\\} -# The variable fullname_syntax_DOS_CASE is a regexp which matches a +# The variable fullname_syntax_DOS_CASE is a regexp which matches a # particular DOS case that GDB most likely will output -# ie. \foo\, but don't match \\.*\ +# ie. "\foo\", but don't match "\\.*\". set fullname_syntax_DOS_CASE {\\[^\\][^\n]*\\} # The variable fullname_syntax_DOS is a regexp which matches a DOS path -# ie. a:\foo\ && a:foo\ +# ie. "a:\foo\" && "a:foo\". set fullname_syntax_DOS {[a-zA-Z]:[^\n]*\\} # The variable fullname_syntax is a regexp which matches what GDB considers -# an absolute path. It is currently debatable if the Windows style paths -# d:foo and \abc should be considered valid as an absolute path. -# Also, the purpse of this regexp is not to recognize a well formed +# an absolute path. It is currently debatable if the Windows style paths +# "d:foo" and "\abc" should be considered valid as an absolute path. +# Also, the purpose of this regexp is not to recognize a well formed # absolute path, but to say with certainty that a path is absolute. set fullname_syntax "($fullname_syntax_POSIX|$fullname_syntax_UNC|$fullname_syntax_DOS_CASE|$fullname_syntax_DOS)" @@ -320,7 +320,7 @@ set fullname_syntax "($fullname_syntax_POSIX|$fullname_syntax_UNC|$fullname_synt global EXEEXT global env -if ![info exists env(EXEEXT)] { +if {![info exists env(EXEEXT)]} { set EXEEXT "" } else { set EXEEXT $env(EXEEXT) @@ -365,7 +365,7 @@ proc default_gdb_version {} { set tmp [lindex $output 1] set version "" regexp " \[0-9\]\[^ \t\n\r\]+" "$tmp" version - if ![is_remote host] { + if {![is_remote host]} { clone_output "[which $GDB] version $version $INTERNAL_GDBFLAGS $GDBFLAGS\n" } else { clone_output "$GDB on remote host version $version $INTERNAL_GDBFLAGS $GDBFLAGS\n" @@ -406,7 +406,7 @@ proc gdb_unload { {msg "file"} } { # Many of the tests depend on setting breakpoints at various places and # running until that breakpoint is reached. At times, we want to start -# with a clean-slate with respect to breakpoints, so this utility proc +# with a clean-slate with respect to breakpoints, so this utility proc # lets us do this without duplicating this code everywhere. # @@ -465,7 +465,7 @@ proc target_can_use_run_cmd { {target_description ""} } { error "invalid argument: $target_description" } - if [target_info exists use_gdb_stub] { + if {[target_info exists use_gdb_stub]} { # In this case, when we connect, the inferior is already # running. return 0 @@ -509,8 +509,8 @@ proc gdb_run_cmd { {inferior_args {}} } { } } - if $use_gdb_stub { - if [target_info exists gdb,do_reload_on_run] { + if {$use_gdb_stub} { + if {[target_info exists gdb,do_reload_on_run]} { if { [gdb_reload $inferior_args] != 0 } { return -1 } @@ -522,7 +522,7 @@ proc gdb_run_cmd { {inferior_args {}} } { return 0 } - if [target_info exists gdb,start_symbol] { + if {[target_info exists gdb,start_symbol]} { set start [target_info gdb,start_symbol] } else { set start "start" @@ -533,11 +533,11 @@ proc gdb_run_cmd { {inferior_args {}} } { # Cap (re)start attempts at three to ensure that this loop # always eventually fails. Don't worry about trying to be # clever and not send a command when it has failed. - if [expr $start_attempt > 3] { + if {$start_attempt > 3} { perror "Jump to start() failed (retry count exceeded)" return -1 } - set start_attempt [expr $start_attempt + 1] + set start_attempt [expr {$start_attempt + 1}] gdb_expect 30 { -re "Continuing at \[^\r\n\]*\[\r\n\]" { set start_attempt 0 @@ -571,7 +571,7 @@ proc gdb_run_cmd { {inferior_args {}} } { return 0 } - if [target_info exists gdb,do_reload_on_run] { + if {[target_info exists gdb,do_reload_on_run]} { if { [gdb_reload $inferior_args] != 0 } { return -1 } @@ -620,7 +620,7 @@ proc gdb_start_cmd { {inferior_args {}} } { } } - if $use_gdb_stub { + if {$use_gdb_stub} { return -1 } @@ -663,7 +663,7 @@ proc gdb_starti_cmd { {inferior_args {}} } { } } - if $use_gdb_stub { + if {$use_gdb_stub} { return -1 } @@ -738,7 +738,7 @@ proc gdb_breakpoint { linespec args } { return 0 } } - -re "Make breakpoint pending.*y or \\\[n\\\]. $" { + -re "Make breakpoint pending.*y or \\\[n\\\]. $" { send_gdb "$pending_response\n" exp_continue } @@ -753,7 +753,7 @@ proc gdb_breakpoint { linespec args } { pass $test_name } return 1 -} +} # Set breakpoint at function and run gdb until it breaks there. # Since this is the only breakpoint that will be set, if it stops @@ -799,7 +799,7 @@ proc runto { linespec args } { } gdb_run_cmd - + # the "at foo.c:36" output we get with -g. # the "in func" output we get without -g. gdb_expect { @@ -828,19 +828,19 @@ proc runto { linespec args } { gdb_internal_error_resync return 0 } - -re "$gdb_prompt $" { + -re "$gdb_prompt $" { if { $print_fail } { fail $test_name } return 0 } - eof { + eof { if { $print_fail } { fail "$test_name (eof)" } return 0 } - timeout { + timeout { if { $print_fail } { fail "$test_name (timeout)" } @@ -1052,7 +1052,7 @@ proc command_to_message { command } { # 1 if the test failed, according to a built-in failure pattern # 0 if only user-supplied patterns matched # -1 if there was an internal error. -# +# # You can use this function thus: # # gdb_test_multiple "print foo" "test foo" { @@ -1157,7 +1157,7 @@ proc gdb_test_multiple { command message args } { break } } - if { [expr $i + 1] < [llength $args] } { + if {$i + 1 < [llength $args]} { error "Too many arguments to gdb_test_multiple" } elseif { ![info exists user_code] } { error "Too few arguments to gdb_test_multiple" @@ -1169,15 +1169,15 @@ proc gdb_test_multiple { command message args } { set message [command_to_message $command] } - if [string match "*\[\r\n\]" $command] { + if {[string match "*\[\r\n\]" $command]} { error "Invalid trailing newline in \"$command\" command" } - if [string match "*\[\003\004\]" $command] { + if {[string match "*\[\003\004\]" $command]} { error "Invalid trailing control code in \"$command\" command" } - if [string match "*\[\r\n\]*" $message] { + if {[string match "*\[\r\n\]*" $message]} { error "Invalid newline in \"$message\" test" } @@ -1302,7 +1302,7 @@ proc gdb_test_multiple { command message args } { while { "$string" != "" } { set foo [string first "\n" "$string"] set len [string length "$string"] - if { $foo < [expr $len - 1] } { + if {$foo < $len - 1} { set str [string range "$string" 0 $foo] if { [send_gdb "$str"] != "" } { verbose -log "Couldn't send $command to GDB." @@ -1318,7 +1318,7 @@ proc gdb_test_multiple { command message args } { -notransfer -re "$multi_line_re$" { verbose "partial: match" 3 } timeout { verbose "partial: timeout" 3 } } - set string [string range "$string" [expr $foo + 1] end] + set string [string range "$string" [expr {$foo + 1}] end] set multi_line_re "$multi_line_re.*\[\r\n\] *>" } else { break @@ -1603,8 +1603,8 @@ proc gdb_test { args } { set message [command_to_message $command] } - set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]] - set nl [expr ${nonl} ? {""} : {"\r\n"}] + set prompt [fill_in_default_prompt $prompt [expr {!${no-prompt-anchor}}]] + set nl [expr {${nonl} ? "" : "\r\n"}] set saw_question 0 @@ -1708,7 +1708,7 @@ proc gdb_test_no_output { args } { set args [lassign $args command message] check_no_args_left - set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]] + set prompt [fill_in_default_prompt $prompt [expr {!${no-prompt-anchor}}]] set command_regex [string_to_regexp $command] return [gdb_test_multiple $command $message -prompt $prompt { @@ -1960,7 +1960,7 @@ proc gdb_test_exact { args } { # string pattern. set pattern [lindex $args 1] - if [string match $pattern ""] { + if {[string match $pattern ""]} { set pattern [string_to_regexp [lindex $args 0]] } else { set pattern [string_to_regexp [lindex $args 1]] @@ -2144,7 +2144,7 @@ proc gdb_test_debug_expr { cmd output {testname "" }} { proc gdb_print_expr_at_depths {exp outputs} { for { set depth 0 } { $depth <= [llength $outputs] } { incr depth } { if { $depth == [llength $outputs] } { - set expected_result [lindex $outputs [expr [llength $outputs] - 1]] + set expected_result [lindex $outputs [expr {[llength $outputs] - 1}]] set depth_string "unlimited" } else { set expected_result [lindex $outputs $depth] @@ -2393,7 +2393,7 @@ proc host_file_join {args} { proc gdb_reinitialize_dir { subdir } { global gdb_prompt - if [is_remote host] { + if {[is_remote host]} { return "" } send_gdb "dir\n" @@ -2435,7 +2435,7 @@ proc default_gdb_exit {} { global gdb_spawn_id inferior_spawn_id global inotify_log_file - if ![info exists gdb_spawn_id] { + if {![info exists gdb_spawn_id]} { return } @@ -2468,7 +2468,7 @@ proc default_gdb_exit {} { } } - if ![is_remote host] { + if {![is_remote host]} { if {[catch { remote_close host } message]} { warning "closing gdb failed with: $message" } @@ -2521,7 +2521,7 @@ proc gdb_file_cmd { arg {kill_flag 1} } { global gdb_file_cmd_debug_info gdb_file_cmd_msg set gdb_file_cmd_debug_info "fail" - if [is_remote host] { + if {[is_remote host]} { set arg [remote_download host $arg] if { $arg == "" } { perror "download failed" @@ -2660,11 +2660,11 @@ proc default_gdb_spawn { } { verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS" gdb_write_cmd_file "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS" - if [info exists gdb_spawn_id] { + if {[info exists gdb_spawn_id]} { return 0 } - if ![is_remote host] { + if {![is_remote host]} { if {[which $GDB] == 0} { perror "$GDB does not exist." exit 1 @@ -2690,7 +2690,7 @@ proc default_gdb_start { } { global gdb_spawn_id global inferior_spawn_id - if [info exists gdb_spawn_id] { + if {[info exists gdb_spawn_id]} { return 0 } @@ -2767,7 +2767,7 @@ proc default_gdb_start { } { send_gdb "set height 0\n" gdb_expect 10 { - -re "$gdb_prompt $" { + -re "$gdb_prompt $" { verbose "Setting height to 0." 2 } timeout { @@ -3242,6 +3242,7 @@ proc foreach_with_prefix {var list body} { # within 'with_test_prefix "$proc_name" { ... }'. proc proc_with_prefix {name arguments body} { # Define the advertised proc. + # tclint-disable-next-line command-args proc $name $arguments [list with_test_prefix $name $body] } @@ -3304,8 +3305,8 @@ proc save_vars { vars body } { # name may be a not-yet-interpolated string like env($foo) set var [uplevel 1 list $var] - if [uplevel 1 [list info exists $var]] { - if [uplevel 1 [list array exists $var]] { + if {[uplevel 1 [list info exists $var]]} { + if {[uplevel 1 [list array exists $var]]} { set saved_arrays($var) [uplevel 1 [list array get $var]] } else { set saved_scalars($var) [uplevel 1 [list set $var]] @@ -3477,14 +3478,14 @@ proc with_gdb_cwd { dir body } { } verbose -log "Switching to directory $dir (saved CWD: $saved_dir)." - if ![gdb_cd $dir] { + if {![gdb_cd $dir]} { return } set code [catch {uplevel 1 $body} result] verbose -log "Switching back to $saved_dir." - if ![gdb_cd $saved_dir] { + if {![gdb_cd $saved_dir]} { return } @@ -3662,7 +3663,7 @@ proc clear_gdb_spawn_id {} { proc with_spawn_id { spawn_id body } { global gdb_spawn_id - if [info exists gdb_spawn_id] { + if {[info exists gdb_spawn_id]} { set saved_spawn_id $gdb_spawn_id } @@ -3670,7 +3671,7 @@ proc with_spawn_id { spawn_id body } { set code [catch {uplevel 1 $body} result] - if [info exists saved_spawn_id] { + if {[info exists saved_spawn_id]} { switch_gdb_spawn_id $saved_spawn_id } else { clear_gdb_spawn_id @@ -3708,7 +3709,7 @@ proc get_largest_timeout {} { upvar 2 timeout timeout set tmt 0 - if [info exists timeout] { + if {[info exists timeout]} { set tmt $timeout } if { [info exists gtimeout] && $gtimeout > $tmt } { @@ -3734,7 +3735,7 @@ proc with_timeout_factor { factor body } { set savedtimeout $timeout - set timeout [expr [get_largest_timeout] * $factor] + set timeout [expr {[get_largest_timeout] * $factor}] set code [catch {uplevel 1 $body} result] set timeout $savedtimeout @@ -3896,7 +3897,7 @@ proc can_single_step_to_signal_handler {} { proc supports_process_record {} { - if [target_info exists gdb,use_precord] { + if {[target_info exists gdb,use_precord]} { return [target_info gdb,use_precord] } @@ -3917,7 +3918,7 @@ proc supports_process_record {} { proc supports_reverse {} { - if [target_info exists gdb,can_reverse] { + if {[target_info exists gdb,can_reverse]} { return [target_info gdb,can_reverse] } @@ -4087,12 +4088,12 @@ proc is_x86_like_target {} { if {![istarget "x86_64-*-*"] && ![istarget i?86-*]} { return 0 } - return [expr [is_ilp32_target] && ![is_amd64_regs_target]] + return [expr {[is_ilp32_target] && ![is_amd64_regs_target]}] } # Return 1 if this target is an x86_64 with -m64. proc is_x86_64_m64_target {} { - return [expr [istarget x86_64-*-* ] && [is_lp64_target]] + return [expr {[istarget x86_64-*-* ] && [is_lp64_target]}] } # Return 1 if this target is an arm or aarch32 on aarch64. @@ -4125,7 +4126,7 @@ proc is_aarch64_target {} { return 0 } - return [expr ![is_aarch32_target]] + return [expr {![is_aarch32_target]}] } # Return 1 if displaced stepping is supported on target, otherwise, return 0. @@ -4196,7 +4197,7 @@ gdb_caching_proc libc_has_debug_info {} { } } -# Run a test on the target to see if it supports vmx hardware. Return 1 if so, +# Run a test on the target to see if it supports vmx hardware. Return 1 if so, # 0 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite. gdb_caching_proc allow_altivec_tests {} { @@ -4216,9 +4217,9 @@ gdb_caching_proc allow_altivec_tests {} { } # Make sure we have a compiler that understands altivec. - if [test_compiler_info gcc*] { + if {[test_compiler_info gcc*]} { set compile_flags "additional_flags=-maltivec" - } elseif [test_compiler_info xlc*] { + } elseif {[test_compiler_info xlc*]} { set compile_flags "additional_flags=-qaltivec" } else { verbose "Could not compile with altivec support, returning 0" 2 @@ -4249,11 +4250,11 @@ gdb_caching_proc allow_altivec_tests {} { gdb_run_cmd gdb_expect { -re ".*Illegal instruction.*${gdb_prompt} $" { - verbose -log "\n$me altivec hardware not detected" + verbose -log "\n$me altivec hardware not detected" set allow_vmx_tests 0 } -re ".*$inferior_exited_re normally.*${gdb_prompt} $" { - verbose -log "\n$me: altivec hardware detected" + verbose -log "\n$me: altivec hardware detected" set allow_vmx_tests 1 } default { @@ -4331,9 +4332,9 @@ gdb_caching_proc allow_vsx_tests {} { } # Make sure we have a compiler that understands altivec. - if [test_compiler_info gcc*] { + if {[test_compiler_info gcc*]} { set compile_flags "additional_flags=-mvsx" - } elseif [test_compiler_info xlc*] { + } elseif {[test_compiler_info xlc*]} { set compile_flags "additional_flags=-qasm=gcc" } else { verbose "Could not compile with vsx support, returning 0" 2 @@ -4694,7 +4695,7 @@ gdb_caching_proc allow_btrace_tests {} { gdb_start gdb_reinitialize_dir $srcdir/$subdir gdb_load $obj - if ![runto_main] { + if {![runto_main]} { return 0 } # In case of an unexpected output, we return 2 as a fail value. @@ -4745,7 +4746,7 @@ gdb_caching_proc allow_btrace_pt_tests {} { gdb_start gdb_reinitialize_dir $srcdir/$subdir gdb_load $obj - if ![runto_main] { + if {![runto_main]} { return 0 } # In case of an unexpected output, we return 2 as a fail value. @@ -4803,7 +4804,7 @@ gdb_caching_proc allow_btrace_ptw_tests {} { gdb_start gdb_reinitialize_dir $srcdir/$subdir gdb_load "$obj" - if ![runto_main] { + if {![runto_main]} { return 1 } @@ -4871,7 +4872,7 @@ gdb_caching_proc allow_btrace_pt_event_trace_tests {} { gdb_start gdb_reinitialize_dir $srcdir/$subdir gdb_load "$obj" - if ![runto_main] { + if {![runto_main]} { return 0 } @@ -5343,12 +5344,12 @@ gdb_caching_proc has_int128_cxx {} { # Return true if the IFUNC feature is supported. gdb_caching_proc allow_ifunc_tests {} { - if [gdb_can_simple_compile ifunc { + if {[gdb_can_simple_compile ifunc { extern void f_ (); typedef void F (void); F* g (void) { return &f_; } void f () __attribute__ ((ifunc ("g"))); - } object] { + } object]} { return 1 } else { return 0 @@ -5430,9 +5431,9 @@ proc allow_hw_breakpoint_tests {} { } # These targets support hardware breakpoints natively - if { [istarget "i?86-*-*"] + if { [istarget "i?86-*-*"] || [istarget "x86_64-*-*"] - || [istarget "ia64-*-*"] + || [istarget "ia64-*-*"] || [istarget "arm*-*-*"] || [istarget "aarch64*-*-*"] || [istarget "s390*-*-*"] } { @@ -5454,9 +5455,9 @@ proc allow_hw_watchpoint_tests {} { # Note, not all Power 9 processors support hardware watchpoints due to a HW # bug. Use has_hw_wp_support to check do a runtime check for hardware # watchpoint support on Powerpc. - if { [istarget "i?86-*-*"] + if { [istarget "i?86-*-*"] || [istarget "x86_64-*-*"] - || [istarget "ia64-*-*"] + || [istarget "ia64-*-*"] || [istarget "arm*-*-*"] || [istarget "aarch64*-*-*"] || ([istarget "powerpc*-*-linux*"] && [has_hw_wp_support]) @@ -5544,7 +5545,7 @@ proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } { -re "\r\n$prompt_regexp" { } } - set skip [expr !$supported] + set skip [expr {!$supported}] return $skip } @@ -5615,7 +5616,7 @@ proc is_any_target {args} { proc use_gdb_stub {} { global use_gdb_stub - if [info exists use_gdb_stub] { + if {[info exists use_gdb_stub]} { return $use_gdb_stub } @@ -5664,7 +5665,7 @@ gdb_caching_proc target_is_gdbserver {} { # # [ catch "exec $compiler -E $ifile > $binfile.ci" exec_output ] # source $binfile.ci -# +# # This avoids the problem with -E and -o together. This almost works # if the build machine is the same as the host machine, which is # usually true of the targets which are not gcc. But this code does @@ -5689,7 +5690,7 @@ gdb_caching_proc target_is_gdbserver {} { # Unfortunately, expect logs the output of the command as it goes by, # and dejagnu helpfully prints a second copy of it right afterwards. # So I turn off expect logging for a moment. -# +# # [ gdb_compile $ifile $ciexe_file executable $args ] # [ remote_exec $ciexe_file ] # [ source $ci_file.out ] @@ -5737,7 +5738,7 @@ gdb_caching_proc get_compiler_info_1 {language} { # Toggle gdb.log to keep the compiler output out of the log. set saved_log [log_file -info] log_file - if [is_remote host] { + if {[is_remote host]} { # We have to use -E and -o together, despite the comments # above, because of how DejaGnu handles remote host testing. set ppout [standard_temp_file compiler.i] @@ -5766,6 +5767,7 @@ gdb_caching_proc get_compiler_info_1 {language} { } elseif { [ regexp "^\[\n\r\t \]*set\[\n\r\t \]" "$cppline" ] } { # eval this line verbose "get_compiler_info: $cppline" 2 + # tclint-disable-next-line command-args eval "$cppline" } elseif { [ regexp {[fc]lang.*warning.*'-fdiagnostics-color=never'} "$cppline"] } { # Both flang preprocessors (llvm flang and classic flang) print a @@ -5782,7 +5784,7 @@ gdb_caching_proc get_compiler_info_1 {language} { } # Set to unknown if for some reason compiler_info didn't get defined. - if ![info exists compiler_info] { + if {![info exists compiler_info]} { verbose -log "get_compiler_info: compiler_info not provided" set compiler_info "unknown" } @@ -5810,7 +5812,7 @@ proc test_compiler_info { {compiler ""} {language "c"} } { # An error will already have been printed in this case. Just # return a suitable result depending on how the user called # this function. - if [string match "" $compiler] { + if {[string match "" $compiler]} { return "" } else { return false @@ -5818,7 +5820,7 @@ proc test_compiler_info { {compiler ""} {language "c"} } { } # If no arg, return the compiler_info string. - if [string match "" $compiler] { + if {[string match "" $compiler]} { return $compiler_info } @@ -5860,7 +5862,7 @@ proc gcc_major_version { {compiler "gcc-*"} {language "c"} } { proc current_target_name { } { global target_info - if [info exists target_info(target,name)] { + if {[info exists target_info(target,name)]} { set answer $target_info(target,name) } else { set answer "" @@ -5886,7 +5888,7 @@ proc gdb_wrapper_init { args } { set result [build_wrapper "testglue.o"] if { $result != "" } { set gdb_wrapper_file [lindex $result 0] - if ![is_remote host] { + if {![is_remote host]} { set gdb_wrapper_file [file join [pwd] $gdb_wrapper_file] } set gdb_wrapper_flags [lindex $result 1] @@ -6305,7 +6307,7 @@ proc gdb_compile {source dest type options} { foreach opt $options { if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name] && $type == "executable"} { - if [test_compiler_info "xlc-*"] { + if {[test_compiler_info "xlc-*"]} { # IBM xlc compiler doesn't accept shared library named other # than .so: use "-Wl," to bypass this lappend source "-Wl,$shlib_name" @@ -6432,7 +6434,7 @@ proc gdb_compile {source dest type options} { } set options $new_options - if [info exists GDB_TESTCASE_OPTIONS] { + if {[info exists GDB_TESTCASE_OPTIONS]} { lappend options "additional_flags=$GDB_TESTCASE_OPTIONS" } verbose "options are $options" @@ -6451,7 +6453,7 @@ proc gdb_compile {source dest type options} { # to disable compiler warnings. set nowarnings [lsearch -exact $options nowarnings] if {$nowarnings != -1} { - if [target_info exists gdb,nowarnings_flag] { + if {[target_info exists gdb,nowarnings_flag]} { set flag "additional_flags=[target_info gdb,nowarnings_flag]" } else { set flag "additional_flags=-w" @@ -6463,7 +6465,7 @@ proc gdb_compile {source dest type options} { # to enable PIE executables. set pie [lsearch -exact $options pie] if {$pie != -1} { - if [target_info exists gdb,pie_flag] { + if {[target_info exists gdb,pie_flag]} { set flag "additional_flags=[target_info gdb,pie_flag]" } else { # For safety, use fPIE rather than fpie. On AArch64, m68k, PowerPC @@ -6476,7 +6478,7 @@ proc gdb_compile {source dest type options} { } set options [lreplace $options $pie $pie $flag] - if [target_info exists gdb,pie_ldflag] { + if {[target_info exists gdb,pie_ldflag]} { set flag "ldflags=[target_info gdb,pie_ldflag]" } else { set flag "ldflags=-pie" @@ -6488,14 +6490,14 @@ proc gdb_compile {source dest type options} { # flags to disable PIE executables. set nopie [lsearch -exact $options nopie] if {$nopie != -1} { - if [target_info exists gdb,nopie_flag] { + if {[target_info exists gdb,nopie_flag]} { set flag "additional_flags=[target_info gdb,nopie_flag]" } else { set flag "additional_flags=-fno-pie" } set options [lreplace $options $nopie $nopie $flag] - if [target_info exists gdb,nopie_ldflag] { + if {[target_info exists gdb,nopie_ldflag]} { set flag "ldflags=[target_info gdb,nopie_ldflag]" } else { set flag "ldflags=-no-pie" @@ -6580,7 +6582,7 @@ proc gdb_compile {source dest type options} { # Automatically handle includes in testsuite/lib/. auto_lappend_include_files options $source - cond_wrap [expr $pie != -1 || $nopie != -1] \ + cond_wrap [expr {$pie != -1 || $nopie != -1}] \ with_PIE_multilib_flags_filtered { set result [target_compile $source $dest $type $options] } @@ -6601,7 +6603,7 @@ proc gdb_compile {source dest type options} { regsub "\[\r\n\]*$" "$result" "" result regsub "^\[\r\n\]*" "$result" "" result - + if { $type == "executable" && $result == "" \ && ($nopie != -1 || $pie != -1) } { set is_pie [exec_is_pie "$dest"] @@ -6717,7 +6719,7 @@ proc gdb_compile_shlib_1 {sources dest options} { lappend objects $source continue } - + set sourcebase [file tail $source] if { $ada } { @@ -6751,7 +6753,7 @@ proc gdb_compile_shlib_1 {sources dest options} { set idx [lsearch $link_options "ada"] set link_options [lreplace $link_options $idx $idx] } - if [test_compiler_info "xlc-*"] { + if {[test_compiler_info "xlc-*"]} { lappend link_options "additional_flags=-qmkshrobj" } else { lappend link_options "additional_flags=-shared" @@ -6932,6 +6934,7 @@ proc send_gdb { string {type standard}} { proc send_inferior { string } { global inferior_spawn_id + # tclint-disable-next-line command-args if {[catch "send -i $inferior_spawn_id -- \$string" errorInfo]} { return "$errorInfo" } else { @@ -6952,7 +6955,7 @@ proc gdb_expect { args } { # A timeout argument takes precedence, otherwise of all the timeouts # select the largest. - if [info exists atimeout] { + if {[info exists atimeout]} { set tmt $atimeout } else { set tmt [get_largest_timeout] @@ -6990,7 +6993,7 @@ proc gdb_expect_list {test sentinel list} { while { ${index} < [llength ${list}] } { set pattern [lindex ${list} ${index}] - set index [expr ${index} + 1] + incr index verbose -log "gdb_expect_list pattern: /$pattern/" 2 if { ${index} == [llength ${list}] } { if { ${ok} } { @@ -7198,7 +7201,7 @@ proc gdb_attach { testpid args } { # Return 1 if GDB managed to start and attach to the process, 0 otherwise. proc_with_prefix gdb_spawn_attach_cmdline { testpid } { - if ![can_spawn_for_attach] { + if {![can_spawn_for_attach]} { # The caller should have checked can_spawn_for_attach itself # before getting here. error "can't spawn for attach with this target/board" @@ -7251,7 +7254,7 @@ proc kill_wait_spawned_process { proc_spawn_id } { remote_exec build "kill -9 ${pid}" verbose -log "closing ${proc_spawn_id}" - catch "close -i $proc_spawn_id" + catch {close -i $proc_spawn_id} verbose -log "waiting for ${proc_spawn_id}" # If somehow GDB ends up still attached to the process here, a @@ -7303,7 +7306,7 @@ proc spawn_wait_for_attach_1 { executable_list } { # this when [can_spawn_for_attach] is false. proc spawn_wait_for_attach { executable_list } { - if ![can_spawn_for_attach] { + if {![can_spawn_for_attach]} { # The caller should have checked can_spawn_for_attach itself # before getting here. error "can't spawn for attach with this target/board" @@ -7320,7 +7323,7 @@ proc spawn_wait_for_attach { executable_list } { proc gdb_load_cmd { args } { global gdb_prompt - if [target_info exists gdb_load_timeout] { + if {[target_info exists gdb_load_timeout]} { set loadtimeout [target_info gdb_load_timeout] } else { set loadtimeout 1600 @@ -7577,7 +7580,7 @@ proc gdb_download_shlib { file } { proc gdb_locate_shlib { file } { global gdb_spawn_id - if ![info exists gdb_spawn_id] { + if {![info exists gdb_spawn_id]} { perror "gdb_load_shlib: GDB is not running" } @@ -7777,7 +7780,7 @@ proc default_gdb_init { test_file_name } { global cleanfiles_target global cleanfiles_host global pf_prefix - + # Reset the timeout value to the default. This way, any testcase # that changes the timeout value without resetting it cannot affect # the timeout used in subsequent testcases. @@ -7820,7 +7823,7 @@ proc default_gdb_init { test_file_name } { global banned_variables global banned_procedures global banned_traced - if (!$banned_traced) { + if {!$banned_traced} { foreach banned_var $banned_variables { global "$banned_var" trace add variable "$banned_var" write error @@ -7930,26 +7933,26 @@ proc default_gdb_init { test_file_name } { if { $gdb_wrapper_target != [current_target_name] } { set gdb_wrapper_initialized 0 } - + # Unlike most tests, we have a small number of tests that generate # a very large amount of output. We therefore increase the expect # buffer size to be able to contain the entire test output. This # is especially needed by gdb.base/info-macros.exp. match_max -d 65536 - # Also set this value for the currently running GDB. + # Also set this value for the currently running GDB. match_max [match_max -d] # We want to add the name of the TCL testcase to the PASS/FAIL messages. set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:" global gdb_prompt - if [target_info exists gdb_prompt] { + if {[target_info exists gdb_prompt]} { set gdb_prompt [target_info gdb_prompt] } else { set gdb_prompt "\\(gdb\\)" } global use_gdb_stub - if [info exists use_gdb_stub] { + if {[info exists use_gdb_stub]} { unset use_gdb_stub } @@ -8206,7 +8209,7 @@ proc standard_testfile {args} { # the same timeout as the default dejagnu timeout, unless the user has # already provided a specific value (probably through a site.exp file). global gdb_test_timeout -if ![info exists gdb_test_timeout] { +if {![info exists gdb_test_timeout]} { set gdb_test_timeout $timeout } @@ -8265,8 +8268,11 @@ proc gdb_cleanup_globals {} { # proc. set temp [interp create] if { [interp eval $temp "info procs ::unknown"] != "" } { + # tclint-disable-next-line command-args set old_args [interp eval $temp "info args ::unknown"] + # tclint-disable-next-line command-args set old_body [interp eval $temp "info body ::unknown"] + # tclint-disable-next-line command-args proc gdb_tcl_unknown $old_args $old_body } interp delete $temp @@ -8315,7 +8321,7 @@ proc gdb_finish { } { global banned_variables global banned_procedures global banned_traced - if ($banned_traced) { + if {$banned_traced} { foreach banned_var $banned_variables { global "$banned_var" trace remove variable "$banned_var" write error @@ -8379,7 +8385,7 @@ proc get_debug_format { } { proc test_debug_format {format} { global debug_format - return [expr [string match $format $debug_format] != 0] + return [expr {[string match $format $debug_format] != 0}] } # Like setup_xfail, but takes the name of a debug format (DWARF 1, @@ -8401,7 +8407,7 @@ proc setup_xfail_format { format } { # # Search the source file FILE, and return the line number of the # first line containing TEXT. If no match is found, an error is thrown. -# +# # TEXT is a string literal, not a regular expression. # # The default value of FILE is "$srcdir/$subdir/$srcfile". If FILE is @@ -8413,18 +8419,18 @@ proc setup_xfail_format { format } { # # Use this function to keep your test scripts independent of the # exact line numbering of the source file. Don't write: -# +# # send_gdb "break 20" -# -# This means that if anyone ever edits your test's source file, +# +# This means that if anyone ever edits your test's source file, # your test could break. Instead, put a comment like this on the # source file line you want to break at: -# +# # /* breakpoint spot: frotz.exp: test name */ -# +# # and then write, in your test script (which we assume is named # frotz.exp): -# +# # send_gdb "break [gdb_get_line_number "frotz.exp: test name"]\n" # # (Yes, Tcl knows how to handle the nested quotes and brackets. @@ -8432,7 +8438,7 @@ proc setup_xfail_format { format } { # $ tclsh # % puts "foo [lindex "bar baz" 1]" # foo baz -# % +# % # Tcl is quite clever, for a little stringy language.) # # === @@ -8549,7 +8555,7 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} { if { [target_info exists exit_is_reliable] } { set exit_is_reliable [target_info exit_is_reliable] } else { - set exit_is_reliable [expr ! $use_gdb_stub] + set exit_is_reliable [expr {! $use_gdb_stub}] } if { ! $exit_is_reliable } { @@ -8571,7 +8577,7 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} { proc rerun_to_main {} { global gdb_prompt use_gdb_stub - if $use_gdb_stub { + if {$use_gdb_stub} { gdb_run_cmd gdb_expect { -re ".*Breakpoint .*main .*$gdb_prompt $"\ @@ -8669,7 +8675,7 @@ proc exec_is_pie { executable } { # registers. gdb_caching_proc allow_float_test {} { - if [target_info exists gdb,skip_float_tests] { + if {[target_info exists gdb,skip_float_tests]} { return 0 } @@ -8767,7 +8773,7 @@ gdb_caching_proc allow_float_test {} { # due to lack of stdio support. proc gdb_skip_stdio_test { msg } { - if [target_info exists gdb,noinferiorio] { + if {[target_info exists gdb,noinferiorio]} { verbose "Skipping test '$msg': no inferior i/o." return 1 } @@ -8879,7 +8885,7 @@ gdb_caching_proc gdb_has_argv0 {} { -re "${gdb_prompt} $" { } } - + gdb_test_no_output "set print elements $old_elements" "" gdb_test_no_output "set print repeats $old_repeats" "" @@ -8946,7 +8952,7 @@ proc get_build_id { filename } { } else { set tmp [standard_output_file "${filename}-tmp"] set objcopy_program [gdb_find_objcopy] - set result [catch "exec $objcopy_program -j .note.gnu.build-id -O binary $filename $tmp" output] + set result [catch {exec $objcopy_program -j .note.gnu.build-id -O binary $filename $tmp} output] verbose "result is $result" verbose "output is $output" if {$result == 1} { @@ -9015,7 +9021,7 @@ proc gdb_gnu_strip_debug { dest args } { # Get rid of the debug info, and store result in stripped_file # something like gdb/testsuite/gdb.base/blah.stripped. - set result [catch "exec $strip_to_file_program --strip-debug ${dest} -o ${stripped_file}" output] + set result [catch {exec $strip_to_file_program --strip-debug ${dest} -o ${stripped_file}} output] verbose "result is $result" verbose "output is $output" if {$result == 1} { @@ -9029,7 +9035,7 @@ proc gdb_gnu_strip_debug { dest args } { # Get rid of everything but the debug info, and store result in debug_file # This will be in the .debug subdirectory, see above. - set result [catch "exec $strip_to_file_program --only-keep-debug ${dest} -o ${debug_file}" output] + set result [catch {exec $strip_to_file_program --only-keep-debug ${dest} -o ${debug_file}} output] verbose "result is $result" verbose "output is $output" if {$result == 1} { @@ -9042,7 +9048,7 @@ proc gdb_gnu_strip_debug { dest args } { # objcopy or strip to remove the symbol table without also removing the # debugging sections, so this is as close as we can get. if {[lsearch -exact $args "no-main"] != -1} { - set result [catch "exec $objcopy_program -N main ${debug_file} ${debug_file}-tmp" output] + set result [catch {exec $objcopy_program -N main ${debug_file} ${debug_file}-tmp} output] verbose "result is $result" verbose "output is $output" if {$result == 1} { @@ -9057,7 +9063,7 @@ proc gdb_gnu_strip_debug { dest args } { # section to the stripped_file, containing a pointer to the # debug_file. if {[lsearch -exact $args "no-debuglink"] == -1} { - set result [catch "exec $objcopy_program --add-gnu-debuglink=${debug_file} ${stripped_file} ${stripped_file}-tmp" output] + set result [catch {exec $objcopy_program --add-gnu-debuglink=${debug_file} ${stripped_file} ${stripped_file}-tmp} output] verbose "result is $result" verbose "output is $output" if {$result == 1} { @@ -9145,12 +9151,12 @@ proc test_user_defined_class_help { {list_of_commands {}} {testname {}} } { # element is abbreviation of. # The command must be a prefix command. EXPECTED_INITIAL_LINES # are regular expressions that should match the beginning of output, -# before the list of subcommands. The presence of +# before the list of subcommands. The presence of # subcommand list and standard epilogue will be tested automatically. proc test_prefix_command_help { command_list expected_initial_lines args } { global help_list_trailer - set command [lindex $command_list 0] - if {[llength $command_list]>1} { + set command [lindex $command_list 0] + if {[llength $command_list]>1} { set full_command [lindex $command_list 1] } else { set full_command $command @@ -9194,7 +9200,7 @@ proc build_executable_from_specs {testname executable options args} { # gdb_compile_shlib and gdb_compile_shlib_pthreads do not use the 3rd # parameter. They also requires $sources while gdb_compile and # gdb_compile_pthreads require $objects. Moreover they ignore any options. - if [string match gdb_compile_shlib* $func] { + if {[string match gdb_compile_shlib* $func]} { set sources_path {} foreach {s local_options} $args { if {[regexp "^/" "$s"]} { @@ -9542,7 +9548,7 @@ gdb_caching_proc target_endianness {} { clean_restart gdb_load $obj - if ![runto_main] { + if {![runto_main]} { return 0 } set res [get_endianness] @@ -9695,6 +9701,7 @@ proc core_find {binfile {deletefiles {}} {arg ""} {output_file "/dev/null"}} { set found 0 set coredir [standard_output_file coredir.[getpid]] file mkdir $coredir + # tclint-disable command-args catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >${output_file} 2>&1\"" # remote_exec host "${binfile}" set binfile_basename [file tail $binfile] @@ -9703,7 +9710,7 @@ proc core_find {binfile {deletefiles {}} {arg ""} {output_file "/dev/null"}} { ${coredir}/core.coremaker.c \ ${coredir}/${binfile_basename}.core \ ${coredir}/${binfile_basename}.exe.core] { - if [remote_file build exists $i] { + if {[remote_file build exists $i]} { remote_exec build "mv $i $destcore" set found 1 } @@ -9725,21 +9732,22 @@ proc core_find {binfile {deletefiles {}} {arg ""} {output_file "/dev/null"}} { # ulimit here if we didn't find a core file above. # Oh, I should mention that any "braindamaged" non-Unix system has # the same problem. I like the cd bit too, it's really neat'n stuff. + # tclint-disable command-args catch "system \"(cd ${objdir}/${subdir}; ${binfile}; true) >/dev/null 2>&1\"" foreach i "${objdir}/${subdir}/core ${objdir}/${subdir}/core.coremaker.c ${binfile}.core" { - if [remote_file build exists $i] { + if {[remote_file build exists $i]} { remote_exec build "mv $i $destcore" set found 1 } } } - # Try to clean up after ourselves. + # Try to clean up after ourselves. foreach deletefile $deletefiles { remote_file build delete [file join $coredir $deletefile] } remote_exec build "rmdir $coredir" - + if { $found == 0 } { warning "can't generate a core file - core tests suppressed - check ulimit -c" return "" @@ -9761,7 +9769,7 @@ gdb_caching_proc gdb_target_symbol_prefix {} { set prefix "" set objdump_program [gdb_find_objdump] - set result [catch "exec $objdump_program --syms $obj" output] + set result [catch {exec $objdump_program --syms $obj} output] if { $result == 0 \ && ![regexp -lineanchor \ @@ -9788,7 +9796,7 @@ gdb_caching_proc target_supports_scheduler_locking {} { clean_restart gdb_load $obj - if ![runto_main] { + if {![runto_main]} { return 0 } @@ -9865,7 +9873,7 @@ proc gdb_target_symbol { symbol } { # surrounding the prefix. It is used to define the macro # SYMBOL_PREFIX for assembly language files. Another version, below, # is used for symbols in inline assembler in C/C++ files. -# +# # The lack of quotes in this version (_asm) makes it possible to # define supporting macros in the .S file. (The version which # uses quotes for the prefix won't work for such files since it's @@ -10001,11 +10009,11 @@ proc parse_list { level listname argset prefix eval } { set result [lsearch -exact $args $pattern] if {$result != -1} { - set value [lindex $args [expr $result+1]] + set value [lindex $args [expr {$result+1}]] if { $eval } { - set value [uplevel [expr $level + 1] [list subst $value]] + set value [uplevel [expr {$level + 1}] [list subst $value]] } - set args [lreplace $args $result [expr $result+1]] + set args [lreplace $args $result [expr {$result+1}]] } else { set value [lindex $argument 1] if { $eval } { @@ -10181,6 +10189,7 @@ proc gdb_define_cmd {command command_list} { # relative path name, and, we sometimes need to close/reopen the log # after changing the current directory. See get_compiler_info. +# tclint-disable redefined-builtin rename cd builtin_cd proc cd { dir } { @@ -10192,7 +10201,7 @@ proc cd { dir } { set log_file_flags "" set log_file_file "" foreach arg [ split "$log_file_info" " "] { - if [string match "-*" $arg] { + if {[string match "-*" $arg]} { lappend log_file_flags $arg } else { lappend log_file_file $arg @@ -10245,9 +10254,9 @@ proc gdb_debug_enabled { } { # If not already read, get the debug setting from environment or board setting. if {![info exists gdbdebug]} { global env - if [info exists env(GDB_DEBUG)] { + if {[info exists env(GDB_DEBUG)]} { set gdbdebug $env(GDB_DEBUG) - } elseif [target_info exists gdb,debug] { + } elseif {[target_info exists gdb,debug]} { set gdbdebug [target_info gdb,debug] } else { return 0 @@ -10264,7 +10273,7 @@ proc gdb_debug_init { } { global gdb_prompt - if ![gdb_debug_enabled] { + if {![gdb_debug_enabled]} { return; } @@ -10302,8 +10311,8 @@ proc gdb_stdin_log_init { } { gdb_persistent_global in_file if {[info exists in_file]} { - # Close existing file. - catch "close $in_file" + # Close existing file. + catch {close $in_file} } set logfile [standard_output_file_with_gdb_instance gdb.in] @@ -10349,7 +10358,7 @@ proc gdb_write_cmd_file { cmdline } { set logfile [standard_output_file_with_gdb_instance gdb.cmd] set cmd_file [open $logfile w] puts $cmd_file $cmdline - catch "close $cmd_file" + catch {close $cmd_file} } # Compare contents of FILE to string STR. Pass with MSG if equal, otherwise @@ -10525,7 +10534,7 @@ proc add_gdb_index { program {style ""} } { global srcdir GDB env set contrib_dir "$srcdir/../contrib" set env(GDB) [append_gdb_data_directory_option $GDB] - set result [catch "exec $contrib_dir/gdb-add-index.sh $style $program" output] + set result [catch {exec $contrib_dir/gdb-add-index.sh {*}$style $program} output] if { $result != 0 } { verbose -log "result is $result" verbose -log "output is $output" @@ -10669,7 +10678,7 @@ proc hex_in_list { val hexlist } { set re 0x0*$val set index [lsearch -regexp $hexlist $re] - return [expr $index != -1] + return [expr {$index != -1}] } # As info args, but also add the default values. @@ -10717,6 +10726,7 @@ proc with_override { name override body } { # Install the override. set new_args [info_args_with_defaults $override] set new_body [info body $override] + # tclint-disable-next-line command-args proc $name $new_args $new_body # Execute body. @@ -10724,6 +10734,7 @@ proc with_override { name override body } { # Restore old proc if it existed on entry, else delete it. if { $existed } { + # tclint-disable-next-line command-args proc $name $old_args $old_body } else { rename $name "" @@ -11051,7 +11062,7 @@ gdb_caching_proc has_hw_wp_support {} { gdb_reinitialize_dir $srcdir/$subdir gdb_load "$obj" - if ![runto_main] { + if {![runto_main]} { gdb_exit remote_file build delete $obj @@ -11138,7 +11149,7 @@ gdb_caching_proc arm_cc_for_target {} { # produced binary actually runs on the system before declaring # we've found the right compiler. - if [istarget "*-linux*-*"] { + if {[istarget "*-linux*-*"]} { set compilers { arm-linux-gnueabi-gcc arm-none-linux-gnueabi-gcc @@ -11521,7 +11532,7 @@ proc have_host_locale { locale } { set locale [string map { "-" "" } $locale] set idx [lsearch [host_locales] $locale] - return [expr $idx != -1] + return [expr {$idx != -1}] } # Return 1 if we can use '#include <$file>' in source file. @@ -11549,7 +11560,7 @@ gdb_caching_proc root_user {} { regexp -all ".*uid=(\[0-9\]+).*" $output dummy uid - return [expr $uid == 0] + return [expr {$uid == 0}] } # Return nul-terminated string read from section SECTION of EXEC. Return "" @@ -11563,7 +11574,7 @@ proc section_get {exec section} { set command "exec $objcopy_program -O binary --set-section-flags $section=A --change-section-address $section=0 -j $section $exec $tmp" verbose -log "command is $command" - set result [catch $command output] + set result [catch {{*}$command} output] verbose -log "result is $result" verbose -log "output is $output" if {$result == 1} { @@ -11580,7 +11591,7 @@ proc section_get {exec section} { verbose -log "section $section not found" return "" } - set retval [string range $data 0 [expr $len - 1]] + set retval [string range $data 0 [expr {$len - 1}]] verbose -log "section $section is <$retval>" return $retval } -- 2.47.3