Imagelibrary/binutils-gdb
1
0
Fork 1
mirror of https://github.com/bminor/binutils-gdb.git synced 2025-12-05 23:23:09 +00:00
Code Issues Packages Projects Releases Wiki Activity

[gdb/testsuite, tclint] Fix lib/gdb.exp

Browse Source
This commit is contained in:
Tom de Vries
2025-10-05 22:50:10 +02:00
parent f06e8324ca
commit 48a5896cd4
2 changed files with 182 additions and 172 deletions
Download Patch File Download Diff File Expand all files Collapse all files

1
gdb/tclint.toml
View File

@@ -33,7 +33,6 @@ exclude = [
# TODO: # TODO:
"gdb/testsuite/boards", "gdb/testsuite/boards",
"gdb/testsuite/config", "gdb/testsuite/config",
"gdb/testsuite/lib/gdb.exp",
# IGNORE (document reason in trailing comment): # IGNORE (document reason in trailing comment):
"gdb/testsuite/gdb.stabs", # To be removed. "gdb/testsuite/gdb.stabs", # To be removed.
"gdb/testsuite/lib/ton.tcl", # Imported. "gdb/testsuite/lib/ton.tcl", # Imported.

267
gdb/testsuite/lib/gdb.exp
View File

@@ -136,7 +136,7 @@ proc load_lib { file } {
set known_globals($varname) 1 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] { foreach varname [info globals] {
if { ![info exists known_globals($varname)] } { if { ![info exists known_globals($varname)] } {
@@ -175,11 +175,11 @@ global GDB_DATA_DIRECTORY
# so input/output is done on gdbserver's tty. # so input/output is done on gdbserver's tty.
global inferior_spawn_id global inferior_spawn_id
if [info exists TOOL_EXECUTABLE] { if {[info exists TOOL_EXECUTABLE]} {
set GDB $TOOL_EXECUTABLE set GDB $TOOL_EXECUTABLE
} }
if ![info exists GDB] { if {![info exists GDB]} {
if ![is_remote host] { if {![is_remote host]} {
set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]] set GDB [findfile $base_dir/../../gdb/gdb "$base_dir/../../gdb/gdb" [transform gdb]]
} else { } else {
set GDB [transform gdb] set GDB [transform gdb]
@@ -188,7 +188,7 @@ if ![info exists GDB] {
# If the user specifies GDB on the command line, and doesn't # If the user specifies GDB on the command line, and doesn't
# specify GDB_DATA_DIRECTORY, then assume we're testing an # specify GDB_DATA_DIRECTORY, then assume we're testing an
# installed GDB, and let it use its own configured data directory. # 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 "" set GDB_DATA_DIRECTORY ""
} }
} }
@@ -197,7 +197,7 @@ verbose "using GDB = $GDB" 2
# The data directory the testing GDB will use. By default, assume # The data directory the testing GDB will use. By default, assume
# we're testing a non-installed GDB in the build directory. Users may # we're testing a non-installed GDB in the build directory. Users may
# also explicitly override the -data-directory from the command line. # 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"] set GDB_DATA_DIRECTORY [file normalize "[pwd]/../data-directory"]
} }
verbose "using GDB_DATA_DIRECTORY = $GDB_DATA_DIRECTORY" 2 verbose "using GDB_DATA_DIRECTORY = $GDB_DATA_DIRECTORY" 2
@@ -225,7 +225,7 @@ proc has_gcore_script {} {
# - append new flags, not overwrite # - append new flags, not overwrite
# - restore the original value when done # - restore the original value when done
global GDBFLAGS global GDBFLAGS
if ![info exists GDBFLAGS] { if {![info exists GDBFLAGS]} {
set GDBFLAGS "" set GDBFLAGS ""
} }
verbose "using GDBFLAGS = $GDBFLAGS" 2 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 # `-data-directory' points to the data directory, usually in the build
# directory. # directory.
global INTERNAL_GDBFLAGS global INTERNAL_GDBFLAGS
if ![info exists INTERNAL_GDBFLAGS] { if {![info exists INTERNAL_GDBFLAGS]} {
set INTERNAL_GDBFLAGS \ set INTERNAL_GDBFLAGS \
[join [list \ [join [list \
"-nw" \ "-nw" \
@@ -297,22 +297,22 @@ set pagination_prompt_str \
set pagination_prompt [string_to_regexp $pagination_prompt_str] set pagination_prompt [string_to_regexp $pagination_prompt_str]
# The variable fullname_syntax_POSIX is a regexp which matches a POSIX # The variable fullname_syntax_POSIX is a regexp which matches a POSIX
# absolute path ie. /foo/ # absolute path ie. "/foo/".
set fullname_syntax_POSIX {/[^\n]*/} set fullname_syntax_POSIX {/[^\n]*/}
# The variable fullname_syntax_UNC is a regexp which matches a Windows # The variable fullname_syntax_UNC is a regexp which matches a Windows
# UNC path ie. \\D\foo\ # UNC path ie. "\\D\foo\".
set fullname_syntax_UNC {\\\\[^\\]+\\[^\n]+\\} 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 # 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]*\\} set fullname_syntax_DOS_CASE {\\[^\\][^\n]*\\}
# The variable fullname_syntax_DOS is a regexp which matches a DOS path # 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]*\\} set fullname_syntax_DOS {[a-zA-Z]:[^\n]*\\}
# The variable fullname_syntax is a regexp which matches what GDB considers # The variable fullname_syntax is a regexp which matches what GDB considers
# an absolute path. It is currently debatable if the Windows style paths # an absolute path. It is currently debatable if the Windows style paths
# d:foo and \abc should be considered valid as an absolute path. # "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 # 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. # 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)" 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 EXEEXT
global env global env
if ![info exists env(EXEEXT)] { if {![info exists env(EXEEXT)]} {
set EXEEXT "" set EXEEXT ""
} else { } else {
set EXEEXT $env(EXEEXT) set EXEEXT $env(EXEEXT)
@@ -365,7 +365,7 @@ proc default_gdb_version {} {
set tmp [lindex $output 1] set tmp [lindex $output 1]
set version "" set version ""
regexp " \[0-9\]\[^ \t\n\r\]+" "$tmp" 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" clone_output "[which $GDB] version $version $INTERNAL_GDBFLAGS $GDBFLAGS\n"
} else { } else {
clone_output "$GDB on remote host version $version $INTERNAL_GDBFLAGS $GDBFLAGS\n" clone_output "$GDB on remote host version $version $INTERNAL_GDBFLAGS $GDBFLAGS\n"
@@ -465,7 +465,7 @@ proc target_can_use_run_cmd { {target_description ""} } {
error "invalid argument: $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 # In this case, when we connect, the inferior is already
# running. # running.
return 0 return 0
@@ -509,8 +509,8 @@ proc gdb_run_cmd { {inferior_args {}} } {
} }
} }
if $use_gdb_stub { if {$use_gdb_stub} {
if [target_info exists gdb,do_reload_on_run] { if {[target_info exists gdb,do_reload_on_run]} {
if { [gdb_reload $inferior_args] != 0 } { if { [gdb_reload $inferior_args] != 0 } {
return -1 return -1
} }
@@ -522,7 +522,7 @@ proc gdb_run_cmd { {inferior_args {}} } {
return 0 return 0
} }
if [target_info exists gdb,start_symbol] { if {[target_info exists gdb,start_symbol]} {
set start [target_info gdb,start_symbol] set start [target_info gdb,start_symbol]
} else { } else {
set start "start" set start "start"
@@ -533,11 +533,11 @@ proc gdb_run_cmd { {inferior_args {}} } {
# Cap (re)start attempts at three to ensure that this loop # Cap (re)start attempts at three to ensure that this loop
# always eventually fails. Don't worry about trying to be # always eventually fails. Don't worry about trying to be
# clever and not send a command when it has failed. # 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)" perror "Jump to start() failed (retry count exceeded)"
return -1 return -1
} }
set start_attempt [expr $start_attempt + 1] set start_attempt [expr {$start_attempt + 1}]
gdb_expect 30 { gdb_expect 30 {
-re "Continuing at \[^\r\n\]*\[\r\n\]" { -re "Continuing at \[^\r\n\]*\[\r\n\]" {
set start_attempt 0 set start_attempt 0
@@ -571,7 +571,7 @@ proc gdb_run_cmd { {inferior_args {}} } {
return 0 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 } { if { [gdb_reload $inferior_args] != 0 } {
return -1 return -1
} }
@@ -620,7 +620,7 @@ proc gdb_start_cmd { {inferior_args {}} } {
} }
} }
if $use_gdb_stub { if {$use_gdb_stub} {
return -1 return -1
} }
@@ -663,7 +663,7 @@ proc gdb_starti_cmd { {inferior_args {}} } {
} }
} }
if $use_gdb_stub { if {$use_gdb_stub} {
return -1 return -1
} }
@@ -1157,7 +1157,7 @@ proc gdb_test_multiple { command message args } {
break break
} }
} }
if { [expr $i + 1] < [llength $args] } { if {$i + 1 < [llength $args]} {
error "Too many arguments to gdb_test_multiple" error "Too many arguments to gdb_test_multiple"
} elseif { ![info exists user_code] } { } elseif { ![info exists user_code] } {
error "Too few arguments to gdb_test_multiple" 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] 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" 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" 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" error "Invalid newline in \"$message\" test"
} }
@@ -1302,7 +1302,7 @@ proc gdb_test_multiple { command message args } {
while { "$string" != "" } { while { "$string" != "" } {
set foo [string first "\n" "$string"] set foo [string first "\n" "$string"]
set len [string length "$string"] set len [string length "$string"]
if { $foo < [expr $len - 1] } { if {$foo < $len - 1} {
set str [string range "$string" 0 $foo] set str [string range "$string" 0 $foo]
if { [send_gdb "$str"] != "" } { if { [send_gdb "$str"] != "" } {
verbose -log "Couldn't send $command to GDB." 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 } -notransfer -re "$multi_line_re$" { verbose "partial: match" 3 }
timeout { verbose "partial: timeout" 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\] *>" set multi_line_re "$multi_line_re.*\[\r\n\] *>"
} else { } else {
break break
@@ -1603,8 +1603,8 @@ proc gdb_test { args } {
set message [command_to_message $command] set message [command_to_message $command]
} }
set prompt [fill_in_default_prompt $prompt [expr !${no-prompt-anchor}]] set prompt [fill_in_default_prompt $prompt [expr {!${no-prompt-anchor}}]]
set nl [expr ${nonl} ? {""} : {"\r\n"}] set nl [expr {${nonl} ? "" : "\r\n"}]
set saw_question 0 set saw_question 0
@@ -1708,7 +1708,7 @@ proc gdb_test_no_output { args } {
set args [lassign $args command message] set args [lassign $args command message]
check_no_args_left 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] set command_regex [string_to_regexp $command]
return [gdb_test_multiple $command $message -prompt $prompt { return [gdb_test_multiple $command $message -prompt $prompt {
@@ -1960,7 +1960,7 @@ proc gdb_test_exact { args } {
# string pattern. # string pattern.
set pattern [lindex $args 1] set pattern [lindex $args 1]
if [string match $pattern ""] { if {[string match $pattern ""]} {
set pattern [string_to_regexp [lindex $args 0]] set pattern [string_to_regexp [lindex $args 0]]
} else { } else {
set pattern [string_to_regexp [lindex $args 1]] 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} { proc gdb_print_expr_at_depths {exp outputs} {
for { set depth 0 } { $depth <= [llength $outputs] } { incr depth } { for { set depth 0 } { $depth <= [llength $outputs] } { incr depth } {
if { $depth == [llength $outputs] } { 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" set depth_string "unlimited"
} else { } else {
set expected_result [lindex $outputs $depth] set expected_result [lindex $outputs $depth]
@@ -2393,7 +2393,7 @@ proc host_file_join {args} {
proc gdb_reinitialize_dir { subdir } { proc gdb_reinitialize_dir { subdir } {
global gdb_prompt global gdb_prompt
if [is_remote host] { if {[is_remote host]} {
return "" return ""
} }
send_gdb "dir\n" send_gdb "dir\n"
@@ -2435,7 +2435,7 @@ proc default_gdb_exit {} {
global gdb_spawn_id inferior_spawn_id global gdb_spawn_id inferior_spawn_id
global inotify_log_file global inotify_log_file
if ![info exists gdb_spawn_id] { if {![info exists gdb_spawn_id]} {
return return
} }
@@ -2468,7 +2468,7 @@ proc default_gdb_exit {} {
} }
} }
if ![is_remote host] { if {![is_remote host]} {
if {[catch { remote_close host } message]} { if {[catch { remote_close host } message]} {
warning "closing gdb failed with: $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 global gdb_file_cmd_debug_info gdb_file_cmd_msg
set gdb_file_cmd_debug_info "fail" set gdb_file_cmd_debug_info "fail"
if [is_remote host] { if {[is_remote host]} {
set arg [remote_download host $arg] set arg [remote_download host $arg]
if { $arg == "" } { if { $arg == "" } {
perror "download failed" perror "download failed"
@@ -2660,11 +2660,11 @@ proc default_gdb_spawn { } {
verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS" verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
gdb_write_cmd_file "$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 return 0
} }
if ![is_remote host] { if {![is_remote host]} {
if {[which $GDB] == 0} { if {[which $GDB] == 0} {
perror "$GDB does not exist." perror "$GDB does not exist."
exit 1 exit 1
@@ -2690,7 +2690,7 @@ proc default_gdb_start { } {
global gdb_spawn_id global gdb_spawn_id
global inferior_spawn_id global inferior_spawn_id
if [info exists gdb_spawn_id] { if {[info exists gdb_spawn_id]} {
return 0 return 0
} }
@@ -3242,6 +3242,7 @@ proc foreach_with_prefix {var list body} {
# within 'with_test_prefix "$proc_name" { ... }'. # within 'with_test_prefix "$proc_name" { ... }'.
proc proc_with_prefix {name arguments body} { proc proc_with_prefix {name arguments body} {
# Define the advertised proc. # Define the advertised proc.
# tclint-disable-next-line command-args
proc $name $arguments [list with_test_prefix $name $body] 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) # name may be a not-yet-interpolated string like env($foo)
set var [uplevel 1 list $var] set var [uplevel 1 list $var]
if [uplevel 1 [list info exists $var]] { if {[uplevel 1 [list info exists $var]]} {
if [uplevel 1 [list array exists $var]] { if {[uplevel 1 [list array exists $var]]} {
set saved_arrays($var) [uplevel 1 [list array get $var]] set saved_arrays($var) [uplevel 1 [list array get $var]]
} else { } else {
set saved_scalars($var) [uplevel 1 [list set $var]] 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)." verbose -log "Switching to directory $dir (saved CWD: $saved_dir)."
if ![gdb_cd $dir] { if {![gdb_cd $dir]} {
return return
} }
set code [catch {uplevel 1 $body} result] set code [catch {uplevel 1 $body} result]
verbose -log "Switching back to $saved_dir." verbose -log "Switching back to $saved_dir."
if ![gdb_cd $saved_dir] { if {![gdb_cd $saved_dir]} {
return return
} }
@@ -3662,7 +3663,7 @@ proc clear_gdb_spawn_id {} {
proc with_spawn_id { spawn_id body } { proc with_spawn_id { spawn_id body } {
global gdb_spawn_id global gdb_spawn_id
if [info exists gdb_spawn_id] { if {[info exists gdb_spawn_id]} {
set saved_spawn_id $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] 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 switch_gdb_spawn_id $saved_spawn_id
} else { } else {
clear_gdb_spawn_id clear_gdb_spawn_id
@@ -3708,7 +3709,7 @@ proc get_largest_timeout {} {
upvar 2 timeout timeout upvar 2 timeout timeout
set tmt 0 set tmt 0
if [info exists timeout] { if {[info exists timeout]} {
set tmt $timeout set tmt $timeout
} }
if { [info exists gtimeout] && $gtimeout > $tmt } { if { [info exists gtimeout] && $gtimeout > $tmt } {
@@ -3734,7 +3735,7 @@ proc with_timeout_factor { factor body } {
set savedtimeout $timeout 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 code [catch {uplevel 1 $body} result]
set timeout $savedtimeout set timeout $savedtimeout
@@ -3896,7 +3897,7 @@ proc can_single_step_to_signal_handler {} {
proc supports_process_record {} { proc supports_process_record {} {
if [target_info exists gdb,use_precord] { if {[target_info exists gdb,use_precord]} {
return [target_info gdb,use_precord] return [target_info gdb,use_precord]
} }
@@ -3917,7 +3918,7 @@ proc supports_process_record {} {
proc supports_reverse {} { proc supports_reverse {} {
if [target_info exists gdb,can_reverse] { if {[target_info exists gdb,can_reverse]} {
return [target_info 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-*]} { if {![istarget "x86_64-*-*"] && ![istarget i?86-*]} {
return 0 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. # Return 1 if this target is an x86_64 with -m64.
proc is_x86_64_m64_target {} { 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. # Return 1 if this target is an arm or aarch32 on aarch64.
@@ -4125,7 +4126,7 @@ proc is_aarch64_target {} {
return 0 return 0
} }
return [expr ![is_aarch32_target]] return [expr {![is_aarch32_target]}]
} }
# Return 1 if displaced stepping is supported on target, otherwise, return 0. # Return 1 if displaced stepping is supported on target, otherwise, return 0.
@@ -4216,9 +4217,9 @@ gdb_caching_proc allow_altivec_tests {} {
} }
# Make sure we have a compiler that understands altivec. # 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" set compile_flags "additional_flags=-maltivec"
} elseif [test_compiler_info xlc*] { } elseif {[test_compiler_info xlc*]} {
set compile_flags "additional_flags=-qaltivec" set compile_flags "additional_flags=-qaltivec"
} else { } else {
verbose "Could not compile with altivec support, returning 0" 2 verbose "Could not compile with altivec support, returning 0" 2
@@ -4331,9 +4332,9 @@ gdb_caching_proc allow_vsx_tests {} {
} }
# Make sure we have a compiler that understands altivec. # 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" set compile_flags "additional_flags=-mvsx"
} elseif [test_compiler_info xlc*] { } elseif {[test_compiler_info xlc*]} {
set compile_flags "additional_flags=-qasm=gcc" set compile_flags "additional_flags=-qasm=gcc"
} else { } else {
verbose "Could not compile with vsx support, returning 0" 2 verbose "Could not compile with vsx support, returning 0" 2
@@ -4694,7 +4695,7 @@ gdb_caching_proc allow_btrace_tests {} {
gdb_start gdb_start
gdb_reinitialize_dir $srcdir/$subdir gdb_reinitialize_dir $srcdir/$subdir
gdb_load $obj gdb_load $obj
if ![runto_main] { if {![runto_main]} {
return 0 return 0
} }
# In case of an unexpected output, we return 2 as a fail value. # 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_start
gdb_reinitialize_dir $srcdir/$subdir gdb_reinitialize_dir $srcdir/$subdir
gdb_load $obj gdb_load $obj
if ![runto_main] { if {![runto_main]} {
return 0 return 0
} }
# In case of an unexpected output, we return 2 as a fail value. # 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_start
gdb_reinitialize_dir $srcdir/$subdir gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj" gdb_load "$obj"
if ![runto_main] { if {![runto_main]} {
return 1 return 1
} }
@@ -4871,7 +4872,7 @@ gdb_caching_proc allow_btrace_pt_event_trace_tests {} {
gdb_start gdb_start
gdb_reinitialize_dir $srcdir/$subdir gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj" gdb_load "$obj"
if ![runto_main] { if {![runto_main]} {
return 0 return 0
} }
@@ -5343,12 +5344,12 @@ gdb_caching_proc has_int128_cxx {} {
# Return true if the IFUNC feature is supported. # Return true if the IFUNC feature is supported.
gdb_caching_proc allow_ifunc_tests {} { gdb_caching_proc allow_ifunc_tests {} {
if [gdb_can_simple_compile ifunc { if {[gdb_can_simple_compile ifunc {
extern void f_ (); extern void f_ ();
typedef void F (void); typedef void F (void);
F* g (void) { return &f_; } F* g (void) { return &f_; }
void f () __attribute__ ((ifunc ("g"))); void f () __attribute__ ((ifunc ("g")));
} object] { } object]} {
return 1 return 1
} else { } else {
return 0 return 0
@@ -5544,7 +5545,7 @@ proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } {
-re "\r\n$prompt_regexp" { -re "\r\n$prompt_regexp" {
} }
} }
set skip [expr !$supported] set skip [expr {!$supported}]
return $skip return $skip
} }
@@ -5615,7 +5616,7 @@ proc is_any_target {args} {
proc use_gdb_stub {} { proc use_gdb_stub {} {
global use_gdb_stub global use_gdb_stub
if [info exists use_gdb_stub] { if {[info exists use_gdb_stub]} {
return $use_gdb_stub return $use_gdb_stub
} }
@@ -5737,7 +5738,7 @@ gdb_caching_proc get_compiler_info_1 {language} {
# Toggle gdb.log to keep the compiler output out of the log. # Toggle gdb.log to keep the compiler output out of the log.
set saved_log [log_file -info] set saved_log [log_file -info]
log_file log_file
if [is_remote host] { if {[is_remote host]} {
# We have to use -E and -o together, despite the comments # We have to use -E and -o together, despite the comments
# above, because of how DejaGnu handles remote host testing. # above, because of how DejaGnu handles remote host testing.
set ppout [standard_temp_file compiler.i] 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" ] } { } elseif { [ regexp "^\[\n\r\t \]*set\[\n\r\t \]" "$cppline" ] } {
# eval this line # eval this line
verbose "get_compiler_info: $cppline" 2 verbose "get_compiler_info: $cppline" 2
# tclint-disable-next-line command-args
eval "$cppline" eval "$cppline"
} elseif { [ regexp {[fc]lang.*warning.*'-fdiagnostics-color=never'} "$cppline"] } { } elseif { [ regexp {[fc]lang.*warning.*'-fdiagnostics-color=never'} "$cppline"] } {
# Both flang preprocessors (llvm flang and classic flang) print a # 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. # 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" verbose -log "get_compiler_info: compiler_info not provided"
set compiler_info "unknown" 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 # An error will already have been printed in this case. Just
# return a suitable result depending on how the user called # return a suitable result depending on how the user called
# this function. # this function.
if [string match "" $compiler] { if {[string match "" $compiler]} {
return "" return ""
} else { } else {
return false return false
@@ -5818,7 +5820,7 @@ proc test_compiler_info { {compiler ""} {language "c"} } {
} }
# If no arg, return the compiler_info string. # If no arg, return the compiler_info string.
if [string match "" $compiler] { if {[string match "" $compiler]} {
return $compiler_info return $compiler_info
} }
@@ -5860,7 +5862,7 @@ proc gcc_major_version { {compiler "gcc-*"} {language "c"} } {
proc current_target_name { } { proc current_target_name { } {
global target_info global target_info
if [info exists target_info(target,name)] { if {[info exists target_info(target,name)]} {
set answer $target_info(target,name) set answer $target_info(target,name)
} else { } else {
set answer "" set answer ""
@@ -5886,7 +5888,7 @@ proc gdb_wrapper_init { args } {
set result [build_wrapper "testglue.o"] set result [build_wrapper "testglue.o"]
if { $result != "" } { if { $result != "" } {
set gdb_wrapper_file [lindex $result 0] 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_file [file join [pwd] $gdb_wrapper_file]
} }
set gdb_wrapper_flags [lindex $result 1] set gdb_wrapper_flags [lindex $result 1]
@@ -6305,7 +6307,7 @@ proc gdb_compile {source dest type options} {
foreach opt $options { foreach opt $options {
if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name] if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
&& $type == "executable"} { && $type == "executable"} {
if [test_compiler_info "xlc-*"] { if {[test_compiler_info "xlc-*"]} {
# IBM xlc compiler doesn't accept shared library named other # IBM xlc compiler doesn't accept shared library named other
# than .so: use "-Wl," to bypass this # than .so: use "-Wl," to bypass this
lappend source "-Wl,$shlib_name" lappend source "-Wl,$shlib_name"
@@ -6432,7 +6434,7 @@ proc gdb_compile {source dest type options} {
} }
set options $new_options set options $new_options
if [info exists GDB_TESTCASE_OPTIONS] { if {[info exists GDB_TESTCASE_OPTIONS]} {
lappend options "additional_flags=$GDB_TESTCASE_OPTIONS" lappend options "additional_flags=$GDB_TESTCASE_OPTIONS"
} }
verbose "options are $options" verbose "options are $options"
@@ -6451,7 +6453,7 @@ proc gdb_compile {source dest type options} {
# to disable compiler warnings. # to disable compiler warnings.
set nowarnings [lsearch -exact $options nowarnings] set nowarnings [lsearch -exact $options nowarnings]
if {$nowarnings != -1} { 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]" set flag "additional_flags=[target_info gdb,nowarnings_flag]"
} else { } else {
set flag "additional_flags=-w" set flag "additional_flags=-w"
@@ -6463,7 +6465,7 @@ proc gdb_compile {source dest type options} {
# to enable PIE executables. # to enable PIE executables.
set pie [lsearch -exact $options pie] set pie [lsearch -exact $options pie]
if {$pie != -1} { 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]" set flag "additional_flags=[target_info gdb,pie_flag]"
} else { } else {
# For safety, use fPIE rather than fpie. On AArch64, m68k, PowerPC # 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] 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]" set flag "ldflags=[target_info gdb,pie_ldflag]"
} else { } else {
set flag "ldflags=-pie" set flag "ldflags=-pie"
@@ -6488,14 +6490,14 @@ proc gdb_compile {source dest type options} {
# flags to disable PIE executables. # flags to disable PIE executables.
set nopie [lsearch -exact $options nopie] set nopie [lsearch -exact $options nopie]
if {$nopie != -1} { 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]" set flag "additional_flags=[target_info gdb,nopie_flag]"
} else { } else {
set flag "additional_flags=-fno-pie" set flag "additional_flags=-fno-pie"
} }
set options [lreplace $options $nopie $nopie $flag] 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]" set flag "ldflags=[target_info gdb,nopie_ldflag]"
} else { } else {
set flag "ldflags=-no-pie" set flag "ldflags=-no-pie"
@@ -6580,7 +6582,7 @@ proc gdb_compile {source dest type options} {
# Automatically handle includes in testsuite/lib/. # Automatically handle includes in testsuite/lib/.
auto_lappend_include_files options $source 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 { with_PIE_multilib_flags_filtered {
set result [target_compile $source $dest $type $options] set result [target_compile $source $dest $type $options]
} }
@@ -6751,7 +6753,7 @@ proc gdb_compile_shlib_1 {sources dest options} {
set idx [lsearch $link_options "ada"] set idx [lsearch $link_options "ada"]
set link_options [lreplace $link_options $idx $idx] set link_options [lreplace $link_options $idx $idx]
} }
if [test_compiler_info "xlc-*"] { if {[test_compiler_info "xlc-*"]} {
lappend link_options "additional_flags=-qmkshrobj" lappend link_options "additional_flags=-qmkshrobj"
} else { } else {
lappend link_options "additional_flags=-shared" lappend link_options "additional_flags=-shared"
@@ -6932,6 +6934,7 @@ proc send_gdb { string {type standard}} {
proc send_inferior { string } { proc send_inferior { string } {
global inferior_spawn_id global inferior_spawn_id
# tclint-disable-next-line command-args
if {[catch "send -i $inferior_spawn_id -- \$string" errorInfo]} { if {[catch "send -i $inferior_spawn_id -- \$string" errorInfo]} {
return "$errorInfo" return "$errorInfo"
} else { } else {
@@ -6952,7 +6955,7 @@ proc gdb_expect { args } {
# A timeout argument takes precedence, otherwise of all the timeouts # A timeout argument takes precedence, otherwise of all the timeouts
# select the largest. # select the largest.
if [info exists atimeout] { if {[info exists atimeout]} {
set tmt $atimeout set tmt $atimeout
} else { } else {
set tmt [get_largest_timeout] set tmt [get_largest_timeout]
@@ -6990,7 +6993,7 @@ proc gdb_expect_list {test sentinel list} {
while { ${index} < [llength ${list}] } { while { ${index} < [llength ${list}] } {
set pattern [lindex ${list} ${index}] set pattern [lindex ${list} ${index}]
set index [expr ${index} + 1] incr index
verbose -log "gdb_expect_list pattern: /$pattern/" 2 verbose -log "gdb_expect_list pattern: /$pattern/" 2
if { ${index} == [llength ${list}] } { if { ${index} == [llength ${list}] } {
if { ${ok} } { 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. # Return 1 if GDB managed to start and attach to the process, 0 otherwise.
proc_with_prefix gdb_spawn_attach_cmdline { testpid } { 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 # The caller should have checked can_spawn_for_attach itself
# before getting here. # before getting here.
error "can't spawn for attach with this target/board" 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}" remote_exec build "kill -9 ${pid}"
verbose -log "closing ${proc_spawn_id}" 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}" verbose -log "waiting for ${proc_spawn_id}"
# If somehow GDB ends up still attached to the process here, a # 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. # this when [can_spawn_for_attach] is false.
proc spawn_wait_for_attach { executable_list } { 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 # The caller should have checked can_spawn_for_attach itself
# before getting here. # before getting here.
error "can't spawn for attach with this target/board" 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 } { proc gdb_load_cmd { args } {
global gdb_prompt global gdb_prompt
if [target_info exists gdb_load_timeout] { if {[target_info exists gdb_load_timeout]} {
set loadtimeout [target_info gdb_load_timeout] set loadtimeout [target_info gdb_load_timeout]
} else { } else {
set loadtimeout 1600 set loadtimeout 1600
@@ -7577,7 +7580,7 @@ proc gdb_download_shlib { file } {
proc gdb_locate_shlib { file } { proc gdb_locate_shlib { file } {
global gdb_spawn_id global gdb_spawn_id
if ![info exists gdb_spawn_id] { if {![info exists gdb_spawn_id]} {
perror "gdb_load_shlib: GDB is not running" perror "gdb_load_shlib: GDB is not running"
} }
@@ -7820,7 +7823,7 @@ proc default_gdb_init { test_file_name } {
global banned_variables global banned_variables
global banned_procedures global banned_procedures
global banned_traced global banned_traced
if (!$banned_traced) { if {!$banned_traced} {
foreach banned_var $banned_variables { foreach banned_var $banned_variables {
global "$banned_var" global "$banned_var"
trace add variable "$banned_var" write error trace add variable "$banned_var" write error
@@ -7943,13 +7946,13 @@ proc default_gdb_init { test_file_name } {
set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:" set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:"
global gdb_prompt global gdb_prompt
if [target_info exists gdb_prompt] { if {[target_info exists gdb_prompt]} {
set gdb_prompt [target_info gdb_prompt] set gdb_prompt [target_info gdb_prompt]
} else { } else {
set gdb_prompt "\\(gdb\\)" set gdb_prompt "\\(gdb\\)"
} }
global use_gdb_stub global use_gdb_stub
if [info exists use_gdb_stub] { if {[info exists use_gdb_stub]} {
unset 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 # the same timeout as the default dejagnu timeout, unless the user has
# already provided a specific value (probably through a site.exp file). # already provided a specific value (probably through a site.exp file).
global gdb_test_timeout global gdb_test_timeout
if ![info exists gdb_test_timeout] { if {![info exists gdb_test_timeout]} {
set gdb_test_timeout $timeout set gdb_test_timeout $timeout
} }
@@ -8265,8 +8268,11 @@ proc gdb_cleanup_globals {} {
# proc. # proc.
set temp [interp create] set temp [interp create]
if { [interp eval $temp "info procs ::unknown"] != "" } { if { [interp eval $temp "info procs ::unknown"] != "" } {
# tclint-disable-next-line command-args
set old_args [interp eval $temp "info args ::unknown"] set old_args [interp eval $temp "info args ::unknown"]
# tclint-disable-next-line command-args
set old_body [interp eval $temp "info body ::unknown"] set old_body [interp eval $temp "info body ::unknown"]
# tclint-disable-next-line command-args
proc gdb_tcl_unknown $old_args $old_body proc gdb_tcl_unknown $old_args $old_body
} }
interp delete $temp interp delete $temp
@@ -8315,7 +8321,7 @@ proc gdb_finish { } {
global banned_variables global banned_variables
global banned_procedures global banned_procedures
global banned_traced global banned_traced
if ($banned_traced) { if {$banned_traced} {
foreach banned_var $banned_variables { foreach banned_var $banned_variables {
global "$banned_var" global "$banned_var"
trace remove variable "$banned_var" write error trace remove variable "$banned_var" write error
@@ -8379,7 +8385,7 @@ proc get_debug_format { } {
proc test_debug_format {format} { proc test_debug_format {format} {
global debug_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, # Like setup_xfail, but takes the name of a debug format (DWARF 1,
@@ -8549,7 +8555,7 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} {
if { [target_info exists exit_is_reliable] } { if { [target_info exists exit_is_reliable] } {
set exit_is_reliable [target_info exit_is_reliable] set exit_is_reliable [target_info exit_is_reliable]
} else { } else {
set exit_is_reliable [expr ! $use_gdb_stub] set exit_is_reliable [expr {! $use_gdb_stub}]
} }
if { ! $exit_is_reliable } { if { ! $exit_is_reliable } {
@@ -8571,7 +8577,7 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} {
proc rerun_to_main {} { proc rerun_to_main {} {
global gdb_prompt use_gdb_stub global gdb_prompt use_gdb_stub
if $use_gdb_stub { if {$use_gdb_stub} {
gdb_run_cmd gdb_run_cmd
gdb_expect { gdb_expect {
-re ".*Breakpoint .*main .*$gdb_prompt $"\ -re ".*Breakpoint .*main .*$gdb_prompt $"\
@@ -8669,7 +8675,7 @@ proc exec_is_pie { executable } {
# registers. # registers.
gdb_caching_proc allow_float_test {} { gdb_caching_proc allow_float_test {} {
if [target_info exists gdb,skip_float_tests] { if {[target_info exists gdb,skip_float_tests]} {
return 0 return 0
} }
@@ -8767,7 +8773,7 @@ gdb_caching_proc allow_float_test {} {
# due to lack of stdio support. # due to lack of stdio support.
proc gdb_skip_stdio_test { msg } { 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." verbose "Skipping test '$msg': no inferior i/o."
return 1 return 1
} }
@@ -8946,7 +8952,7 @@ proc get_build_id { filename } {
} else { } else {
set tmp [standard_output_file "${filename}-tmp"] set tmp [standard_output_file "${filename}-tmp"]
set objcopy_program [gdb_find_objcopy] 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 "result is $result"
verbose "output is $output" verbose "output is $output"
if {$result == 1} { 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 # Get rid of the debug info, and store result in stripped_file
# something like gdb/testsuite/gdb.base/blah.stripped. # 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 "result is $result"
verbose "output is $output" verbose "output is $output"
if {$result == 1} { 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 # Get rid of everything but the debug info, and store result in debug_file
# This will be in the .debug subdirectory, see above. # 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 "result is $result"
verbose "output is $output" verbose "output is $output"
if {$result == 1} { 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 # objcopy or strip to remove the symbol table without also removing the
# debugging sections, so this is as close as we can get. # debugging sections, so this is as close as we can get.
if {[lsearch -exact $args "no-main"] != -1} { 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 "result is $result"
verbose "output is $output" verbose "output is $output"
if {$result == 1} { if {$result == 1} {
@@ -9057,7 +9063,7 @@ proc gdb_gnu_strip_debug { dest args } {
# section to the stripped_file, containing a pointer to the # section to the stripped_file, containing a pointer to the
# debug_file. # debug_file.
if {[lsearch -exact $args "no-debuglink"] == -1} { 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 "result is $result"
verbose "output is $output" verbose "output is $output"
if {$result == 1} { if {$result == 1} {
@@ -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 # gdb_compile_shlib and gdb_compile_shlib_pthreads do not use the 3rd
# parameter. They also requires $sources while gdb_compile and # parameter. They also requires $sources while gdb_compile and
# gdb_compile_pthreads require $objects. Moreover they ignore any options. # 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 {} set sources_path {}
foreach {s local_options} $args { foreach {s local_options} $args {
if {[regexp "^/" "$s"]} { if {[regexp "^/" "$s"]} {
@@ -9542,7 +9548,7 @@ gdb_caching_proc target_endianness {} {
clean_restart clean_restart
gdb_load $obj gdb_load $obj
if ![runto_main] { if {![runto_main]} {
return 0 return 0
} }
set res [get_endianness] set res [get_endianness]
@@ -9695,6 +9701,7 @@ proc core_find {binfile {deletefiles {}} {arg ""} {output_file "/dev/null"}} {
set found 0 set found 0
set coredir [standard_output_file coredir.[getpid]] set coredir [standard_output_file coredir.[getpid]]
file mkdir $coredir file mkdir $coredir
# tclint-disable command-args
catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >${output_file} 2>&1\"" catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >${output_file} 2>&1\""
# remote_exec host "${binfile}" # remote_exec host "${binfile}"
set binfile_basename [file tail $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}/core.coremaker.c \
${coredir}/${binfile_basename}.core \ ${coredir}/${binfile_basename}.core \
${coredir}/${binfile_basename}.exe.core] { ${coredir}/${binfile_basename}.exe.core] {
if [remote_file build exists $i] { if {[remote_file build exists $i]} {
remote_exec build "mv $i $destcore" remote_exec build "mv $i $destcore"
set found 1 set found 1
} }
@@ -9725,9 +9732,10 @@ proc core_find {binfile {deletefiles {}} {arg ""} {output_file "/dev/null"}} {
# ulimit here if we didn't find a core file above. # ulimit here if we didn't find a core file above.
# Oh, I should mention that any "braindamaged" non-Unix system has # 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. # 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\"" catch "system \"(cd ${objdir}/${subdir}; ${binfile}; true) >/dev/null 2>&1\""
foreach i "${objdir}/${subdir}/core ${objdir}/${subdir}/core.coremaker.c ${binfile}.core" { 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" remote_exec build "mv $i $destcore"
set found 1 set found 1
} }
@@ -9761,7 +9769,7 @@ gdb_caching_proc gdb_target_symbol_prefix {} {
set prefix "" set prefix ""
set objdump_program [gdb_find_objdump] 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 \ if { $result == 0 \
&& ![regexp -lineanchor \ && ![regexp -lineanchor \
@@ -9788,7 +9796,7 @@ gdb_caching_proc target_supports_scheduler_locking {} {
clean_restart clean_restart
gdb_load $obj gdb_load $obj
if ![runto_main] { if {![runto_main]} {
return 0 return 0
} }
@@ -10001,11 +10009,11 @@ proc parse_list { level listname argset prefix eval } {
set result [lsearch -exact $args $pattern] set result [lsearch -exact $args $pattern]
if {$result != -1} { if {$result != -1} {
set value [lindex $args [expr $result+1]] set value [lindex $args [expr {$result+1}]]
if { $eval } { 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 { } else {
set value [lindex $argument 1] set value [lindex $argument 1]
if { $eval } { 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 # relative path name, and, we sometimes need to close/reopen the log
# after changing the current directory. See get_compiler_info. # after changing the current directory. See get_compiler_info.
# tclint-disable redefined-builtin
rename cd builtin_cd rename cd builtin_cd
proc cd { dir } { proc cd { dir } {
@@ -10192,7 +10201,7 @@ proc cd { dir } {
set log_file_flags "" set log_file_flags ""
set log_file_file "" set log_file_file ""
foreach arg [ split "$log_file_info" " "] { foreach arg [ split "$log_file_info" " "] {
if [string match "-*" $arg] { if {[string match "-*" $arg]} {
lappend log_file_flags $arg lappend log_file_flags $arg
} else { } else {
lappend log_file_file $arg 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 not already read, get the debug setting from environment or board setting.
if {![info exists gdbdebug]} { if {![info exists gdbdebug]} {
global env global env
if [info exists env(GDB_DEBUG)] { if {[info exists env(GDB_DEBUG)]} {
set gdbdebug $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] set gdbdebug [target_info gdb,debug]
} else { } else {
return 0 return 0
@@ -10264,7 +10273,7 @@ proc gdb_debug_init { } {
global gdb_prompt global gdb_prompt
if ![gdb_debug_enabled] { if {![gdb_debug_enabled]} {
return; return;
} }
@@ -10303,7 +10312,7 @@ proc gdb_stdin_log_init { } {
if {[info exists in_file]} { if {[info exists in_file]} {
# Close existing file. # Close existing file.
catch "close $in_file" catch {close $in_file}
} }
set logfile [standard_output_file_with_gdb_instance gdb.in] 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 logfile [standard_output_file_with_gdb_instance gdb.cmd]
set cmd_file [open $logfile w] set cmd_file [open $logfile w]
puts $cmd_file $cmdline 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 # 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 global srcdir GDB env
set contrib_dir "$srcdir/../contrib" set contrib_dir "$srcdir/../contrib"
set env(GDB) [append_gdb_data_directory_option $GDB] 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 } { if { $result != 0 } {
verbose -log "result is $result" verbose -log "result is $result"
verbose -log "output is $output" verbose -log "output is $output"
@@ -10669,7 +10678,7 @@ proc hex_in_list { val hexlist } {
set re 0x0*$val set re 0x0*$val
set index [lsearch -regexp $hexlist $re] set index [lsearch -regexp $hexlist $re]
return [expr $index != -1] return [expr {$index != -1}]
} }
# As info args, but also add the default values. # As info args, but also add the default values.
@@ -10717,6 +10726,7 @@ 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]
# tclint-disable-next-line command-args
proc $name $new_args $new_body proc $name $new_args $new_body
# Execute body. # Execute body.
@@ -10724,6 +10734,7 @@ proc with_override { name override body } {
# 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 } {
# tclint-disable-next-line command-args
proc $name $old_args $old_body proc $name $old_args $old_body
} else { } else {
rename $name "" rename $name ""
@@ -11051,7 +11062,7 @@ gdb_caching_proc has_hw_wp_support {} {
gdb_reinitialize_dir $srcdir/$subdir gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj" gdb_load "$obj"
if ![runto_main] { if {![runto_main]} {
gdb_exit gdb_exit
remote_file build delete $obj 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 # produced binary actually runs on the system before declaring
# we've found the right compiler. # we've found the right compiler.
if [istarget "*-linux*-*"] { if {[istarget "*-linux*-*"]} {
set compilers { set compilers {
arm-linux-gnueabi-gcc arm-linux-gnueabi-gcc
arm-none-linux-gnueabi-gcc arm-none-linux-gnueabi-gcc
@@ -11521,7 +11532,7 @@ proc have_host_locale { locale } {
set locale [string map { "-" "" } $locale] set locale [string map { "-" "" } $locale]
set idx [lsearch [host_locales] $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. # 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 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 "" # 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" 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" verbose -log "command is $command"
set result [catch $command output] set result [catch {{*}$command} output]
verbose -log "result is $result" verbose -log "result is $result"
verbose -log "output is $output" verbose -log "output is $output"
if {$result == 1} { if {$result == 1} {
@@ -11580,7 +11591,7 @@ proc section_get {exec section} {
verbose -log "section $section not found" verbose -log "section $section not found"
return "" 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>" verbose -log "section $section is <$retval>"
return $retval return $retval
} }