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)] } {
# 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]
# 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 ""
}
}
# 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
# - 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
# `-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" \
# 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)"
global EXEEXT
global env
-if ![info exists env(EXEEXT)] {
+if {![info exists env(EXEEXT)]} {
set EXEEXT ""
} else {
set EXEEXT $env(EXEEXT)
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"
# 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.
#
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
}
}
- 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
}
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"
# 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
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
}
}
}
- if $use_gdb_stub {
+ if {$use_gdb_stub} {
return -1
}
}
}
- if $use_gdb_stub {
+ if {$use_gdb_stub} {
return -1
}
return 0
}
}
- -re "Make breakpoint pending.*y or \\\[n\\\]. $" {
+ -re "Make breakpoint pending.*y or \\\[n\\\]. $" {
send_gdb "$pending_response\n"
exp_continue
}
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
}
gdb_run_cmd
-
+
# the "at foo.c:36" output we get with -g.
# the "in func" output we get without -g.
gdb_expect {
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)"
}
# 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" {
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"
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"
}
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."
-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
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
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 {
# 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]]
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]
proc gdb_reinitialize_dir { subdir } {
global gdb_prompt
- if [is_remote host] {
+ if {[is_remote host]} {
return ""
}
send_gdb "dir\n"
global gdb_spawn_id inferior_spawn_id
global inotify_log_file
- if ![info exists gdb_spawn_id] {
+ if {![info exists gdb_spawn_id]} {
return
}
}
}
- if ![is_remote host] {
+ if {![is_remote host]} {
if {[catch { remote_close host } message]} {
warning "closing gdb failed with: $message"
}
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"
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
global gdb_spawn_id
global inferior_spawn_id
- if [info exists gdb_spawn_id] {
+ if {[info exists gdb_spawn_id]} {
return 0
}
send_gdb "set height 0\n"
gdb_expect 10 {
- -re "$gdb_prompt $" {
+ -re "$gdb_prompt $" {
verbose "Setting height to 0." 2
}
timeout {
# 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]
}
# 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]]
}
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
}
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
}
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
upvar 2 timeout timeout
set tmt 0
- if [info exists timeout] {
+ if {[info exists timeout]} {
set tmt $timeout
}
if { [info exists gtimeout] && $gtimeout > $tmt } {
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
proc supports_process_record {} {
- if [target_info exists gdb,use_precord] {
+ if {[target_info exists gdb,use_precord]} {
return [target_info gdb,use_precord]
}
proc supports_reverse {} {
- if [target_info exists gdb,can_reverse] {
+ if {[target_info exists gdb,can_reverse]} {
return [target_info gdb,can_reverse]
}
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.
return 0
}
- return [expr ![is_aarch32_target]]
+ return [expr {![is_aarch32_target]}]
}
# Return 1 if displaced stepping is supported on target, otherwise, return 0.
}
}
-# 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 {} {
}
# 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
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 {
}
# 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
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.
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.
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj"
- if ![runto_main] {
+ if {![runto_main]} {
return 1
}
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj"
- if ![runto_main] {
+ if {![runto_main]} {
return 0
}
# 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
}
# 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*-*-*"] } {
# 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])
-re "\r\n$prompt_regexp" {
}
}
- set skip [expr !$supported]
+ set skip [expr {!$supported}]
return $skip
}
proc use_gdb_stub {} {
global use_gdb_stub
- if [info exists use_gdb_stub] {
+ if {[info exists use_gdb_stub]} {
return $use_gdb_stub
}
#
# [ 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
# 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 ]
# 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]
} 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
}
# 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"
}
# 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
}
# If no arg, return the compiler_info string.
- if [string match "" $compiler] {
+ if {[string match "" $compiler]} {
return $compiler_info
}
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 ""
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]
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"
}
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"
# 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"
# 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
}
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"
# 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"
# 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]
}
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"]
lappend objects $source
continue
}
-
+
set sourcebase [file tail $source]
if { $ada } {
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"
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 {
# 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]
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} } {
# 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"
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
# 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"
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
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"
}
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.
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
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
}
# 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
}
# 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
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
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,
#
# 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
#
# 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.
# $ tclsh
# % puts "foo [lindex "bar baz" 1]"
# foo baz
-# %
+# %
# Tcl is quite clever, for a little stringy language.)
#
# ===
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 } {
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 $"\
# 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
}
# 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
}
-re "${gdb_prompt} $" {
}
}
-
+
gdb_test_no_output "set print elements $old_elements" ""
gdb_test_no_output "set print repeats $old_repeats" ""
} 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} {
# 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} {
# 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} {
# 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} {
# 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} {
# 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
# 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"]} {
clean_restart
gdb_load $obj
- if ![runto_main] {
+ if {![runto_main]} {
return 0
}
set res [get_endianness]
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]
${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
}
# 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 ""
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 \
clean_restart
gdb_load $obj
- if ![runto_main] {
+ if {![runto_main]} {
return 0
}
# 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
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 } {
# 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 } {
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
# 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
global gdb_prompt
- if ![gdb_debug_enabled] {
+ if {![gdb_debug_enabled]} {
return;
}
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]
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
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"
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.
# 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.
# 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 ""
gdb_reinitialize_dir $srcdir/$subdir
gdb_load "$obj"
- if ![runto_main] {
+ if {![runto_main]} {
gdb_exit
remote_file build delete $obj
# 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
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.
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 ""
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} {
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
}
projects / thirdparty / binutils-gdb.git / commitdiff
