}
}
}
+
+# gdb_test_stdio COMMAND INFERIOR_PATTERN GDB_PATTERN MESSAGE
+# Send a command to gdb; expect inferior and gdb output.
+#
+# See gdb_test_multiple for a description of the COMMAND and MESSAGE
+# parameters.
+#
+# INFERIOR_PATTERN is the pattern to match against inferior output.
+#
+# GDB_PATTERN is the pattern to match against gdb output, and must NOT
+# include the \r\n sequence immediately before the gdb prompt, nor the
+# prompt. The default is empty.
+#
+# Both inferior and gdb patterns must match for a PASS.
+#
+# If MESSAGE is ommitted, then COMMAND will be used as the message.
+#
+# Returns:
+# 1 if the test failed,
+# 0 if the test passes,
+# -1 if there was an internal error.
+#
+
+proc gdb_test_stdio {command inferior_pattern {gdb_pattern ""} {message ""}} {
+ global inferior_spawn_id gdb_spawn_id
+ global gdb_prompt
+
+ if {$message == ""} {
+ set message $command
+ }
+
+ set inferior_matched 0
+ set gdb_matched 0
+
+ # Use an indirect spawn id list, and remove the inferior spawn id
+ # from the expected output as soon as it matches, in case
+ # $inferior_pattern happens to be a prefix of the resulting full
+ # gdb pattern below (e.g., "\r\n").
+ global gdb_test_stdio_spawn_id_list
+ set gdb_test_stdio_spawn_id_list "$inferior_spawn_id"
+
+ # Note that if $inferior_spawn_id and $gdb_spawn_id are different,
+ # then we may see gdb's output arriving before the inferior's
+ # output.
+ set res [gdb_test_multiple $command $message {
+ -i gdb_test_stdio_spawn_id_list -re "$inferior_pattern" {
+ set inferior_matched 1
+ if {!$gdb_matched} {
+ set gdb_test_stdio_spawn_id_list ""
+ exp_continue
+ }
+ }
+ -i $gdb_spawn_id -re "$gdb_pattern\r\n$gdb_prompt $" {
+ set gdb_matched 1
+ if {!$inferior_matched} {
+ exp_continue
+ }
+ }
+ }]
+ if {$res == 0} {
+ pass $message
+ } else {
+ verbose -log "inferior_matched=$inferior_matched, gdb_matched=$gdb_matched"
+ }
+ return $res
+}
+
\f
# Issue a PASS and return true if evaluating CONDITION in the caller's
}
# Return a 1 for configurations that do not support Python scripting.
+# PROMPT_REGEXP is the expected prompt.
-proc skip_python_tests {} {
- global gdb_prompt
+proc skip_python_tests_prompt { prompt_regexp } {
global gdb_py_is_py3k
global gdb_py_is_py24
gdb_test_multiple "python print ('test')" "verify python support" {
- -re "not supported.*$gdb_prompt $" {
+ -re "not supported.*$prompt_regexp" {
unsupported "Python support is disabled."
return 1
}
- -re "$gdb_prompt $" {}
+ -re "$prompt_regexp" {}
}
set gdb_py_is_py24 0
gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" {
- -re "3.*$gdb_prompt $" {
+ -re "3.*$prompt_regexp" {
set gdb_py_is_py3k 1
}
- -re ".*$gdb_prompt $" {
+ -re ".*$prompt_regexp" {
set gdb_py_is_py3k 0
}
}
if { $gdb_py_is_py3k == 0 } {
gdb_test_multiple "python print (sys.version_info\[1\])" "check if python 2.4" {
- -re "\[45\].*$gdb_prompt $" {
+ -re "\[45\].*$prompt_regexp" {
set gdb_py_is_py24 1
}
- -re ".*$gdb_prompt $" {
+ -re ".*$prompt_regexp" {
set gdb_py_is_py24 0
}
}
return 0
}
+# Return a 1 for configurations that do not support Python scripting.
+# Note: This also sets various globals that specify which version of Python
+# is in use. See skip_python_tests_prompt.
+
+proc skip_python_tests {} {
+ global gdb_prompt
+ return [skip_python_tests_prompt "$gdb_prompt $"]
+}
+
# Return a 1 if we should skip shared library tests.
proc skip_shlib_tests {} {
}
}
+# Run BODY in the context of the caller. After BODY is run, the variables
+# listed in VARS will be reset to the values they had before BODY was run.
+#
+# This is useful for providing a scope in which it is safe to temporarily
+# modify global variables, e.g.
+#
+# global INTERNAL_GDBFLAGS
+# global env
+#
+# set foo GDBHISTSIZE
+#
+# save_vars { INTERNAL_GDBFLAGS env($foo) env(HOME) } {
+# append INTERNAL_GDBFLAGS " -nx"
+# unset -nocomplain env(GDBHISTSIZE)
+# gdb_start
+# gdb_test ...
+# }
+#
+# Here, although INTERNAL_GDBFLAGS, env(GDBHISTSIZE) and env(HOME) may be
+# modified inside BODY, this proc guarantees that the modifications will be
+# undone after BODY finishes executing.
+
+proc save_vars { vars body } {
+ array set saved_scalars { }
+ array set saved_arrays { }
+ set unset_vars { }
+
+ foreach var $vars {
+ # First evaluate VAR in the context of the caller in case the variable
+ # 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]] {
+ set saved_arrays($var) [uplevel 1 [list array get $var]]
+ } else {
+ set saved_scalars($var) [uplevel 1 [list set $var]]
+ }
+ } else {
+ lappend unset_vars $var
+ }
+ }
+
+ set code [catch {uplevel 1 $body} result]
+
+ foreach {var value} [array get saved_scalars] {
+ uplevel 1 [list set $var $value]
+ }
+
+ foreach {var value} [array get saved_arrays] {
+ uplevel 1 [list unset $var]
+ uplevel 1 [list array set $var $value]
+ }
+
+ foreach var $unset_vars {
+ uplevel 1 [list unset -nocomplain $var]
+ }
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
+
# Run tests in BODY with GDB prompt and variable $gdb_prompt set to
# PROMPT. When BODY is finished, restore GDB prompt and variable
# $gdb_prompt.
}
}
-# Return 1 if target hardware or OS supports single stepping to signal
-# handler, otherwise, return 0.
+# Return 1 if the target supports hardware single stepping.
-proc can_single_step_to_signal_handler {} {
+proc can_hardware_single_step {} {
- # Targets don't have hardware single step. On these targets, when
- # a signal is delivered during software single step, gdb is unable
- # to determine the next instruction addresses, because start of signal
- # handler is one of them.
if { [istarget "arm*-*-*"] || [istarget "mips*-*-*"]
|| [istarget "tic6x-*-*"] || [istarget "sparc*-*-linux*"]
|| [istarget "nios2-*-*"] } {
return 1
}
+# Return 1 if target hardware or OS supports single stepping to signal
+# handler, otherwise, return 0.
+
+proc can_single_step_to_signal_handler {} {
+ # Targets don't have hardware single step. On these targets, when
+ # a signal is delivered during software single step, gdb is unable
+ # to determine the next instruction addresses, because start of signal
+ # handler is one of them.
+ return [can_hardware_single_step]
+}
+
# Return 1 if target supports process record, otherwise return 0.
proc supports_process_record {} {
if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
|| [istarget "i\[34567\]86-*-linux*"]
|| [istarget "aarch64*-*-linux*"]
- || [istarget "powerpc*-*-linux*"] } {
+ || [istarget "powerpc*-*-linux*"]
+ || [istarget "s390*-*-linux*"] } {
return 1
}
if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
|| [istarget "i\[34567\]86-*-linux*"]
|| [istarget "aarch64*-*-linux*"]
- || [istarget "powerpc*-*-linux*"] } {
+ || [istarget "powerpc*-*-linux*"]
+ || [istarget "s390*-*-linux*"] } {
return 1
}
if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"]
|| [istarget "arm*-*-linux*"] || [istarget "powerpc-*-linux*"]
- || [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"] } {
+ || [istarget "powerpc64-*-linux*"] || [istarget "s390*-*-*"]
+ || [istarget "aarch64*-*-linux*"] } {
return 1
}
return $skip_vsx_tests
}
+# Run a test on the target to see if it supports TSX hardware. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+gdb_caching_proc skip_tsx_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_tsx_tests"
+
+ set src [standard_temp_file tsx[pid].c]
+ set exe [standard_temp_file tsx[pid].x]
+
+ gdb_produce_source $src {
+ int main() {
+ asm volatile ("xbegin .L0");
+ asm volatile ("xend");
+ asm volatile (".L0: nop");
+ return 0;
+ }
+ }
+
+ verbose "$me: compiling testfile $src" 2
+ set lines [gdb_compile $src $exe executable {nowarnings quiet}]
+ file delete $src
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed." 2
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$exe"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "$me: TSX hardware not detected."
+ set skip_tsx_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "$me: TSX hardware detected."
+ set skip_tsx_tests 0
+ }
+ default {
+ warning "\n$me: default case taken."
+ set skip_tsx_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $exe
+
+ verbose "$me: returning $skip_tsx_tests" 2
+ return $skip_tsx_tests
+}
+
# Run a test on the target to see if it supports btrace hardware. Return 0 if so,
# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
return $skip_btrace_tests
}
+# Run a test on the target to see if it supports btrace pt hardware.
+# Return 0 if so, 1 if it does not. Based on 'check_vmx_hw_available'
+# from the GCC testsuite.
+
+gdb_caching_proc skip_btrace_pt_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_btrace_tests"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support btrace, returning 1" 2
+ return 1
+ }
+
+ # Set up, compile, and execute a test program.
+ # Include the current process ID in the file names to prevent conflicts
+ # with invocations for multiple testsuites.
+ set src [standard_temp_file btrace[pid].c]
+ set exe [standard_temp_file btrace[pid].x]
+
+ gdb_produce_source $src {
+ int main(void) { return 0; }
+ }
+
+ verbose "$me: compiling testfile $src" 2
+ set compile_flags {debug nowarnings quiet}
+ set lines [gdb_compile $src $exe executable $compile_flags]
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed, returning 1" 2
+ file delete $src
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load $exe
+ if ![runto_main] {
+ file delete $src
+ return 1
+ }
+ file delete $src
+ # In case of an unexpected output, we return 2 as a fail value.
+ set skip_btrace_tests 2
+ gdb_test_multiple "record btrace pt" "check btrace support" {
+ -re "You can't do that when your target is.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "Target does not support branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "^record btrace pt\r\n$gdb_prompt $" {
+ set skip_btrace_tests 0
+ }
+ }
+ gdb_exit
+ remote_file build delete $exe
+
+ verbose "$me: returning $skip_btrace_tests" 2
+ return $skip_btrace_tests
+}
+
# Skip all the tests in the file if you are not on an hppa running
# hpux target.
# it.
proc can_spawn_for_attach { } {
- # We use TCL's exec to get the inferior's pid.
+ # We use exp_pid to get the inferior's pid, assuming that gives
+ # back the pid of the program. On remote boards, that would give
+ # us instead the PID of e.g., the ssh client, etc.
if [is_remote target] then {
return 0
}
return 1
}
+# Kill a progress previously started with spawn_wait_for_attach, and
+# reap its wait status. PROC_SPAWN_ID is the spawn id associated with
+# the process.
+
+proc kill_wait_spawned_process { proc_spawn_id } {
+ set pid [exp_pid -i $proc_spawn_id]
+
+ verbose -log "killing ${pid}"
+ remote_exec build "kill -9 ${pid}"
+
+ verbose -log "closing ${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
+ # blocking wait hangs until gdb is killed (or until gdb / the
+ # ptracer reaps the exit status too, but that won't happen because
+ # something went wrong.) Passing -nowait makes expect tell Tcl to
+ # wait for the PID in the background. That's fine because we
+ # don't care about the exit status. */
+ wait -nowait -i $proc_spawn_id
+}
+
+# Returns the process id corresponding to the given spawn id.
+
+proc spawn_id_get_pid { spawn_id } {
+ set testpid [exp_pid -i $spawn_id]
+
+ if { [istarget "*-*-cygwin*"] } {
+ # testpid is the Cygwin PID, GDB uses the Windows PID, which
+ # might be different due to the way fork/exec works.
+ set testpid [ exec ps -e | gawk "{ if (\$1 == $testpid) print \$4; }" ]
+ }
+
+ return $testpid
+}
+
# Start a set of programs running and then wait for a bit, to be sure
-# that they can be attached to. Return a list of the processes' PIDs.
-# It's a test error to call this when [can_spawn_for_attach] is false.
+# that they can be attached to. Return a list of processes spawn IDs,
+# one element for each process spawned. It's a test error to call
+# this when [can_spawn_for_attach] is false.
proc spawn_wait_for_attach { executable_list } {
- set pid_list {}
+ set spawn_id_list {}
if ![can_spawn_for_attach] {
# The caller should have checked can_spawn_for_attach itself
}
foreach {executable} $executable_list {
- lappend pid_list [eval exec $executable &]
+ # Note we use Expect's spawn, not Tcl's exec, because with
+ # spawn we control when to wait for/reap the process. That
+ # allows killing the process by PID without being subject to
+ # pid-reuse races.
+ lappend spawn_id_list [remote_spawn target $executable]
}
sleep 2
- if { [istarget "*-*-cygwin*"] } {
- for {set i 0} {$i < [llength $pid_list]} {incr i} {
- # testpid is the Cygwin PID, GDB uses the Windows PID,
- # which might be different due to the way fork/exec works.
- set testpid [lindex $pid_list $i]
- set testpid [ exec ps -e | gawk "{ if (\$1 == $testpid) print \$4; }" ]
- set pid_list [lreplace $pid_list $i $i $testpid]
- }
- }
-
- return $pid_list
+ return $spawn_id_list
}
#
}
}
+# Return a path using GDB_PARALLEL.
+# ARGS is a list of path elements to append to "$objdir/$GDB_PARALLEL".
+# GDB_PARALLEL must be defined, the caller must check.
+#
+# The default value for GDB_PARALLEL is, canonically, ".".
+# The catch is that tests don't expect an additional "./" in file paths so
+# omit any directory for the default case.
+# GDB_PARALLEL is written as "yes" for the default case in Makefile.in to mark
+# its special handling.
+
+proc make_gdb_parallel_path { args } {
+ global GDB_PARALLEL objdir
+ set joiner [list "file" "join" $objdir]
+ if { $GDB_PARALLEL != "yes" } {
+ lappend joiner $GDB_PARALLEL
+ }
+ set joiner [concat $joiner $args]
+ return [eval $joiner]
+}
+
# Turn BASENAME into a full file name in the standard output
# directory. It is ok if BASENAME is the empty string; in this case
# the directory is returned.
global objdir subdir gdb_test_file_name GDB_PARALLEL
if {[info exists GDB_PARALLEL]} {
- set dir [file join $objdir $GDB_PARALLEL outputs $subdir $gdb_test_file_name]
+ set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name]
file mkdir $dir
return [file join $dir $basename]
} else {
global objdir GDB_PARALLEL
if {[info exists GDB_PARALLEL]} {
- return [file join $objdir $GDB_PARALLEL temp $basename]
+ return [make_gdb_parallel_path temp $basename]
} else {
return $basename
}
unset GDB_PARALLEL
} else {
file mkdir \
- [file join $GDB_PARALLEL outputs] \
- [file join $GDB_PARALLEL temp] \
- [file join $GDB_PARALLEL cache]
+ [make_gdb_parallel_path outputs] \
+ [make_gdb_parallel_path temp] \
+ [make_gdb_parallel_path cache]
}
}
return $destcore
}
+# gdb_target_symbol_prefix compiles a test program and then examines
+# the output from objdump to determine the prefix (such as underscore)
+# for linker symbol prefixes.
+
+gdb_caching_proc gdb_target_symbol_prefix {
+ # Set up and compile a simple test program...
+ set src [standard_temp_file main[pid].c]
+ set exe [standard_temp_file main[pid].x]
+
+ gdb_produce_source $src {
+ int main() {
+ return 0;
+ }
+ }
+
+ verbose "compiling testfile $src" 2
+ set compile_flags {debug nowarnings quiet}
+ set lines [gdb_compile $src $exe executable $compile_flags]
+
+ set prefix ""
+
+ if ![string match "" $lines] then {
+ verbose "gdb_target_symbol_prefix: testfile compilation failed, returning null prefix" 2
+ } else {
+ set objdump_program [gdb_find_objdump]
+ set result [catch "exec $objdump_program --syms $exe" output]
+
+ if { $result == 0 \
+ && ![regexp -lineanchor \
+ { ([^ a-zA-Z0-9]*)main$} $output dummy prefix] } {
+ verbose "gdb_target_symbol_prefix: Could not find main in objdump output; returning null prefix" 2
+ }
+ }
+
+ file delete $src
+ file delete $exe
+
+ return $prefix
+}
+
+# gdb_target_symbol returns the provided symbol with the correct prefix
+# prepended. (See gdb_target_symbol_prefix, above.)
+
+proc gdb_target_symbol { symbol } {
+ set prefix [gdb_target_symbol_prefix]
+ return "${prefix}${symbol}"
+}
+
# gdb_target_symbol_prefix_flags returns a string that can be added
# to gdb_compile options to define SYMBOL_PREFIX macro value
# symbol_prefix_flags returns a string that can be added
# number of items expected to be passed into the procedure...
}
-# Capture the output of COMMAND in a string ignoring PREFIX; return that string.
+# Capture the output of COMMAND in a string ignoring PREFIX (a regexp);
+# return that string.
+
proc capture_command_output { command prefix } {
global gdb_prompt
global expect_out
set output_string ""
gdb_test_multiple "$command" "capture_command_output for $command" {
- -re "${command}\[\r\n\]+${prefix}(.*)\[\r\n\]+$gdb_prompt $" {
+ -re "[string_to_regexp ${command}]\[\r\n\]+${prefix}(.*)\[\r\n\]+$gdb_prompt $" {
set output_string $expect_out(1,string)
}
}
projects / deliverable / binutils-gdb.git / blobdiff