exit 2
}
+# List of procs to run in gdb_finish.
+set gdb_finish_hooks [list]
+
+# Variable in which we keep track of globals that are allowed to be live
+# across test-cases.
+array set gdb_persistent_globals {}
+
+# Mark variable names in ARG as a persistent global, and declare them as
+# global in the calling context. Can be used to rewrite "global var_a var_b"
+# into "gdb_persistent_global var_a var_b".
+proc gdb_persistent_global { args } {
+ global gdb_persistent_globals
+ foreach varname $args {
+ uplevel 1 global $varname
+ set gdb_persistent_globals($varname) 1
+ }
+}
+
+# Mark variable names in ARG as a persistent global.
+proc gdb_persistent_global_no_decl { args } {
+ global gdb_persistent_globals
+ foreach varname $args {
+ set gdb_persistent_globals($varname) 1
+ }
+}
+
+# Override proc load_lib.
+rename load_lib saved_load_lib
+# Run the runtest version of load_lib, and mark all variables that were
+# created by this call as persistent.
+proc load_lib { file } {
+ array set known_global {}
+ foreach varname [info globals] {
+ set known_globals($varname) 1
+ }
+
+ set code [catch "saved_load_lib $file" result]
+
+ foreach varname [info globals] {
+ if { ![info exists known_globals($varname)] } {
+ gdb_persistent_global_no_decl $varname
+ }
+ }
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code error -errorinfo $errorInfo -errorcode $errorCode $result
+ } elseif {$code > 1} {
+ return -code $code $result
+ }
+
+ return $result
+}
+
load_lib libgloss.exp
load_lib cache.exp
load_lib gdb-utils.exp
load_lib memory.exp
+load_lib check-test-names.exp
global GDB
set octal "\[0-7\]+"
-set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)"
+set inferior_exited_re "(?:\\\[Inferior \[0-9\]+ \\(\[^\n\r\]*\\) exited)"
# A regular expression that matches a value history number.
# E.g., $1, $2, etc.
#
proc gdb_unload {} {
- global verbose
global GDB
global gdb_prompt
send_gdb "file\n"
# Generic run command.
#
+# Return 0 if we could start the program, -1 if we could not.
+#
# The second pattern below matches up to the first newline *only*.
# Using ``.*$'' could swallow up output that we attempt to match
# elsewhere.
#
+# INFERIOR_ARGS is passed as arguments to the start command, so may contain
+# inferior arguments.
+#
# N.B. This function does not wait for gdb to return to the prompt,
# that is the caller's responsibility.
-proc gdb_run_cmd {args} {
+proc gdb_run_cmd { {inferior_args {}} } {
global gdb_prompt use_gdb_stub
foreach command [gdb_init_commands] {
if $use_gdb_stub {
if [target_info exists gdb,do_reload_on_run] {
- if { [gdb_reload] != 0 } {
- return
+ if { [gdb_reload $inferior_args] != 0 } {
+ return -1
}
send_gdb "continue\n"
gdb_expect 60 {
-re "Continu\[^\r\n\]*\[\r\n\]" {}
default {}
}
- return
+ return 0
}
if [target_info exists gdb,start_symbol] {
# clever and not send a command when it has failed.
if [expr $start_attempt > 3] {
perror "Jump to start() failed (retry count exceeded)"
- return
+ return -1
}
set start_attempt [expr $start_attempt + 1]
gdb_expect 30 {
}
-re "No symbol \"_start\" in current.*$gdb_prompt $" {
perror "Can't find start symbol to run in gdb_run"
- return
+ return -1
}
-re "No symbol \"start\" in current.*$gdb_prompt $" {
send_gdb "jump *_start\n"
send_gdb "y\n" answer
}
-re "The program is not being run.*$gdb_prompt $" {
- if { [gdb_reload] != 0 } {
- return
+ if { [gdb_reload $inferior_args] != 0 } {
+ return -1
}
send_gdb "jump *$start\n"
}
timeout {
perror "Jump to start() failed (timeout)"
- return
+ return -1
}
}
}
- return
+
+ return 0
}
if [target_info exists gdb,do_reload_on_run] {
- if { [gdb_reload] != 0 } {
- return
+ if { [gdb_reload $inferior_args] != 0 } {
+ return -1
}
}
- send_gdb "run $args\n"
+ send_gdb "run $inferior_args\n"
# This doesn't work quite right yet.
# Use -notransfer here so that test cases (like chng-sym.exp)
# may test for additional start-up messages.
# There is no more input expected.
}
}
+
+ return 0
}
# Generic start command. Return 0 if we could start the program, -1
# if we could not.
#
+# INFERIOR_ARGS is passed as arguments to the start command, so may contain
+# inferior arguments.
+#
# N.B. This function does not wait for gdb to return to the prompt,
# that is the caller's responsibility.
-proc gdb_start_cmd {args} {
+proc gdb_start_cmd { {inferior_args {}} } {
global gdb_prompt use_gdb_stub
foreach command [gdb_init_commands] {
return -1
}
- send_gdb "start $args\n"
+ send_gdb "start $inferior_args\n"
# Use -notransfer here so that test cases (like chng-sym.exp)
# may test for additional start-up messages.
gdb_expect 60 {
# Generic starti command. Return 0 if we could start the program, -1
# if we could not.
#
+# INFERIOR_ARGS is passed as arguments to the starti command, so may contain
+# inferior arguments.
+#
# N.B. This function does not wait for gdb to return to the prompt,
# that is the caller's responsibility.
-proc gdb_starti_cmd {args} {
+proc gdb_starti_cmd { {inferior_args {}} } {
global gdb_prompt use_gdb_stub
foreach command [gdb_init_commands] {
return -1
}
- send_gdb "starti $args\n"
+ send_gdb "starti $inferior_args\n"
gdb_expect 60 {
-re "The program .* has been started already.*y or n. $" {
send_gdb "y\n" answer
return 0
}
-re ".*A problem internal to GDB has been detected" {
- if { $print_fail } {
- fail "$test_name (GDB internal error)"
- }
+ # Always emit a FAIL if we encounter an internal error: internal
+ # errors are never expected.
+ fail "$test_name (GDB internal error)"
gdb_internal_error_resync
return 0
}
}
-# gdb_test_multiple COMMAND MESSAGE EXPECT_ARGUMENTS PROMPT_REGEXP
+# gdb_test_multiple COMMAND MESSAGE [ -promp PROMPT_REGEXP] [ -lbl ]
+# EXPECT_ARGUMENTS
# Send a command to gdb; test the result.
#
# COMMAND is the command to execute, send to GDB with send_gdb. If
# this is the null string no command is sent.
# MESSAGE is a message to be printed with the built-in failure patterns
# if one of them matches. If MESSAGE is empty COMMAND will be used.
+# -prompt PROMPT_REGEXP specifies a regexp matching the expected prompt
+# after the command output. If empty, defaults to "$gdb_prompt $".
+# -lbl specifies that line-by-line matching will be used.
# EXPECT_ARGUMENTS will be fed to expect in addition to the standard
# patterns. Pattern elements will be evaluated in the caller's
# context; action elements will be executed in the caller's context.
# Unlike patterns for gdb_test, these patterns should generally include
# the final newline and prompt.
-# PROMPT_REGEXP is a regexp matching the expected prompt after the command
-# output. If empty, defaults to "$gdb_prompt $"
#
# Returns:
# 1 if the test failed, according to a built-in failure pattern
# }
# }
#
-proc gdb_test_multiple { command message user_code { prompt_regexp "" } } {
+proc gdb_test_multiple { command message args } {
global verbose use_gdb_stub
global gdb_prompt pagination_prompt
global GDB
upvar expect_out expect_out
global any_spawn_id
+ set line_by_line 0
+ set prompt_regexp ""
+ for {set i 0} {$i < [llength $args]} {incr i} {
+ set arg [lindex $args $i]
+ if { $arg == "-prompt" } {
+ incr i
+ set prompt_regexp [lindex $args $i]
+ } elseif { $arg == "-lbl" } {
+ set line_by_line 1
+ } else {
+ set user_code $arg
+ break
+ }
+ }
+ if { [expr $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"
+ }
+
if { "$prompt_regexp" == "" } {
set prompt_regexp "$gdb_prompt $"
}
}
}
+ if {$line_by_line} {
+ append code {
+ -re "\r\n\[^\r\n\]*(?=\r\n)" {
+ exp_continue
+ }
+ }
+ }
+
# Now patterns that apply to any spawn id specified.
append code {
-i $any_spawn_id
return $result
}
+# Usage: gdb_test_multiline NAME INPUT RESULT {INPUT RESULT} ...
+# Run a test named NAME, consisting of multiple lines of input.
+# After each input line INPUT, search for result line RESULT.
+# Succeed if all results are seen; fail otherwise.
+
+proc gdb_test_multiline { name args } {
+ global gdb_prompt
+ set inputnr 0
+ foreach {input result} $args {
+ incr inputnr
+ if {[gdb_test_multiple $input "$name: input $inputnr: $input" {
+ -re "\[\r\n\]*($result)\[\r\n\]+($gdb_prompt | *>)$" {
+ pass $gdb_test_name
+ }
+ }]} {
+ return 1
+ }
+ }
+ return 0
+}
+
+
# gdb_test COMMAND PATTERN MESSAGE QUESTION RESPONSE
# Send a command to gdb; test the result.
#
set message $condition
}
- set res [uplevel 1 expr $condition]
- if {!$res} {
+ set code [catch {uplevel 1 expr $condition} res]
+ if {$code != 0 || !$res} {
fail $message
} else {
pass $message
proc default_gdb_exit {} {
global GDB
global INTERNAL_GDBFLAGS GDBFLAGS
- global verbose
global gdb_spawn_id inferior_spawn_id
global inotify_log_file
proc gdb_file_cmd { arg } {
global gdb_prompt
- global verbose
global GDB
global last_loaded_file
}
send_gdb "file $arg\n"
+ set new_symbol_table 0
+ set basename [file tail $arg]
gdb_expect 120 {
-re "Reading symbols from.*LZMA support was disabled.*$gdb_prompt $" {
verbose "\t\tLoaded $arg into $GDB; .gnu_debugdata found but no LZMA available"
return 0
}
-re "Load new symbol table from \".*\".*y or n. $" {
+ if { $new_symbol_table > 0 } {
+ perror [join [list "Couldn't load $basename,"
+ "interactive prompt loop detected."]]
+ return -1
+ }
send_gdb "y\n" answer
- gdb_expect 120 {
- -re "Reading symbols from.*$gdb_prompt $" {
- verbose "\t\tLoaded $arg with new symbol table into $GDB"
- set gdb_file_cmd_debug_info "debug"
- return 0
- }
- timeout {
- perror "Couldn't load $arg, other program already loaded (timeout)."
- return -1
- }
- eof {
- perror "Couldn't load $arg, other program already loaded (eof)."
- return -1
- }
- }
+ incr new_symbol_table
+ set suffix "-- with new symbol table"
+ set arg "$arg $suffix"
+ set basename "$basename $suffix"
+ exp_continue
}
-re "No such file or directory.*$gdb_prompt $" {
- perror "($arg) No such file or directory"
+ perror "($basename) No such file or directory"
return -1
}
-re "A problem internal to GDB has been detected" {
- fail "($arg) (GDB internal error)"
+ perror "Couldn't load $basename into GDB (GDB internal error)."
gdb_internal_error_resync
return -1
}
-re "$gdb_prompt $" {
- perror "Couldn't load $arg into $GDB."
+ perror "Couldn't load $basename into GDB."
return -1
}
timeout {
- perror "Couldn't load $arg into $GDB (timeout)."
+ perror "Couldn't load $basename into GDB (timeout)."
return -1
}
eof {
# This is an attempt to detect a core dump, but seems not to
# work. Perhaps we need to match .* followed by eof, in which
# gdb_expect does not seem to have a way to do that.
- perror "Couldn't load $arg into $GDB (eof)."
+ perror "Couldn't load $basename into GDB (eof)."
return -1
}
}
unset gdb_spawn_id
return -1
}
+ eof {
+ perror "(eof) GDB never initialized."
+ unset gdb_spawn_id
+ return -1
+ }
}
# force the height to "unlimited", so no pagers get used
proc skip_python_tests_prompt { prompt_regexp } {
global gdb_py_is_py3k
- gdb_test_multiple "python print ('test')" "verify python support" {
- -re "not supported.*$prompt_regexp" {
- unsupported "Python support is disabled."
- return 1
+ gdb_test_multiple "python print ('test')" "verify python support" \
+ -prompt "$prompt_regexp" {
+ -re "not supported.*$prompt_regexp" {
+ unsupported "Python support is disabled."
+ return 1
+ }
+ -re "$prompt_regexp" {}
}
- -re "$prompt_regexp" {}
- } "$prompt_regexp"
- gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" {
- -re "3.*$prompt_regexp" {
- set gdb_py_is_py3k 1
- }
- -re ".*$prompt_regexp" {
- set gdb_py_is_py3k 0
- }
- } "$prompt_regexp"
+ gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" \
+ -prompt "$prompt_regexp" {
+ -re "3.*$prompt_regexp" {
+ set gdb_py_is_py3k 1
+ }
+ -re ".*$prompt_regexp" {
+ set gdb_py_is_py3k 0
+ }
+ }
return 0
}
} executable]
}
+# Return 1 if compiling go is supported.
+gdb_caching_proc support_go_compile {
+
+ return [gdb_can_simple_compile go-hello {
+ package main
+ import "fmt"
+ func main() {
+ fmt.Println("hello world")
+ }
+ } executable go]
+}
+
# Return 1 if GDB can get a type for siginfo from the target, otherwise
# return 0.
return $skip_tsx_tests
}
+# Run a test on the target to see if it supports avx512bf16. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+gdb_caching_proc skip_avx512bf16_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_avx512bf16_tests"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support avx512bf16, returning 1" 2
+ return 1
+ }
+
+ # Compile a test program.
+ set src {
+ int main() {
+ asm volatile ("vcvtne2ps2bf16 %xmm0, %xmm1, %xmm0");
+ return 0;
+ }
+ }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$obj"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "$me: avx512bf16 hardware not detected."
+ set skip_avx512bf16_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "$me: avx512bf16 hardware detected."
+ set skip_avx512bf16_tests 0
+ }
+ default {
+ warning "\n$me: default case taken."
+ set skip_avx512bf16_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_avx512bf16_tests" 2
+ return $skip_avx512bf16_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.
proc skip_libstdcxx_probe_tests_prompt { prompt_regexp } {
set supported 0
- gdb_test_multiple "info probe" "check for stap probe in libstdc++" {
- -re ".*libstdcxx.*catch.*\r\n$prompt_regexp" {
- set supported 1
- }
- -re "\r\n$prompt_regexp" {
+ gdb_test_multiple "info probe" "check for stap probe in libstdc++" \
+ -prompt "$prompt_regexp" {
+ -re ".*libstdcxx.*catch.*\r\n$prompt_regexp" {
+ set supported 1
+ }
+ -re "\r\n$prompt_regexp" {
+ }
}
- } "$prompt_regexp"
set skip [expr !$supported]
return $skip
}
proc gdb_is_target_1 { target_name target_stack_regexp prompt_regexp } {
set test "probe for target ${target_name}"
- gdb_test_multiple "maint print target-stack" $test {
- -re "${target_stack_regexp}${prompt_regexp}" {
- pass $test
- return 1
- }
- -re "$prompt_regexp" {
- pass $test
+ gdb_test_multiple "maint print target-stack" $test \
+ -prompt "$prompt_regexp" {
+ -re "${target_stack_regexp}${prompt_regexp}" {
+ pass $test
+ return 1
+ }
+ -re "$prompt_regexp" {
+ pass $test
+ }
}
- } "$prompt_regexp"
return 0
}
set gdb_wrapper_initialized 0
set gdb_wrapper_target ""
+set gdb_wrapper_file ""
+set gdb_wrapper_flags ""
proc gdb_wrapper_init { args } {
global gdb_wrapper_initialized
set result [build_wrapper "testglue.o"]
if { $result != "" } {
set gdb_wrapper_file [lindex $result 0]
+ if ![is_remote host] {
+ set gdb_wrapper_file [file join [pwd] $gdb_wrapper_file]
+ }
set gdb_wrapper_flags [lindex $result 1]
} else {
warning "Status wrapper failed to build."
}
+ } else {
+ set gdb_wrapper_file ""
+ set gdb_wrapper_flags ""
}
+ verbose "set gdb_wrapper_file = $gdb_wrapper_file"
set gdb_wrapper_initialized 1
set gdb_wrapper_target [current_target_name]
}
set postfix "s"
}
}
- set src [standard_temp_file $name-[pid].c]
+ set ext "c"
+ foreach flag $compile_flags {
+ if { "$flag" == "go" } {
+ set ext "go"
+ break
+ }
+ }
+ set src [standard_temp_file $name-[pid].$ext]
set obj [standard_temp_file $name-[pid].$postfix]
set compile_flags [concat $compile_flags {debug nowarnings quiet}]
# - ldflags=flag: Add FLAG to the linker flags.
# - incdir=path: Add PATH to the searched include directories.
# - libdir=path: Add PATH to the linker searched directories.
-# - ada, c++, f77: Compile the file as Ada, C++ or Fortran.
+# - ada, c++, f77, f90, go, rust: Compile the file as Ada, C++,
+# Fortran 77, Fortran 90, Go or Rust.
# - debug: Build with debug information.
# - optimize: Build with optimization.
global GDB_TESTCASE_OPTIONS
global gdb_wrapper_file
global gdb_wrapper_flags
- global gdb_wrapper_initialized
global srcdir
global objdir
global gdb_saved_set_unbuffered_mode_obj
set new_options [universal_compile_options]
}
+ # Some C/C++ testcases unconditionally pass -Wno-foo as additional
+ # options to disable some warning. That is OK with GCC, because
+ # by design, GCC accepts any -Wno-foo option, even if it doesn't
+ # support -Wfoo. Clang however warns about unknown -Wno-foo by
+ # default, unless you pass -Wno-unknown-warning-option as well.
+ # We do that here, so that individual testcases don't have to
+ # worry about it.
+ if {[lsearch -exact $options getting_compiler_info] == -1
+ && [lsearch -exact $options rust] == -1
+ && [lsearch -exact $options ada] == -1
+ && [lsearch -exact $options f77] == -1
+ && [lsearch -exact $options f90] == -1
+ && [lsearch -exact $options go] == -1
+ && [test_compiler_info "clang-*"]} {
+ lappend new_options "additional_flags=-Wno-unknown-warning-option"
+ }
+
+ # Treating .c input files as C++ is deprecated in Clang, so
+ # explicitly force C++ language.
+ if { [lsearch -exact $options getting_compiler_info] == -1
+ && [lsearch -exact $options c++] != -1
+ && [test_compiler_info "clang-*"]} {
+ lappend new_options additional_flags=-x\ c++
+ }
+
# Place (and look for) Fortran `.mod` files in the output
# directory for this specific test.
if {[lsearch -exact $options f77] != -1 \
verbose "options are $options"
verbose "source is $source $dest $type $options"
- if { $gdb_wrapper_initialized == 0 } { gdb_wrapper_init }
+ gdb_wrapper_init
if {[target_info exists needs_status_wrapper] && \
[target_info needs_status_wrapper] != "0" && \
- [info exists gdb_wrapper_file]} {
+ $gdb_wrapper_file != "" } {
lappend options "libs=${gdb_wrapper_file}"
lappend options "ldflags=${gdb_wrapper_flags}"
}
fail "$test (bad file format)"
return -1
}
- -re ": No such file or directory.*\r\n$gdb_prompt $" {
+ -re -wrap "[string_to_regexp $core]: No such file or directory.*" {
fail "$test (file not found)"
return -1
}
# either the first time or after already starting the program once,
# for remote targets. Most files that override gdb_load should now
# override this instead.
+#
+# INFERIOR_ARGS contains the arguments to pass to the inferiors, as a
+# single string to get interpreted by a shell. If the target board
+# overriding gdb_reload is a "stub", then it should arrange things such
+# these arguments make their way to the inferior process.
-proc gdb_reload { } {
+proc gdb_reload { {inferior_args {}} } {
# For the benefit of existing configurations, default to gdb_load.
# Specifying no file defaults to the executable currently being
# debugged.
return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"]
}
+# Default implementation of gdb_init.
proc default_gdb_init { test_file_name } {
global gdb_wrapper_initialized
global gdb_wrapper_target
global cleanfiles
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 gdb_test_timeout
+ global timeout
+ set timeout $gdb_test_timeout
+
+ if { [regexp ".*gdb\.reverse\/.*" $test_file_name]
+ && [target_info exists gdb_reverse_timeout] } {
+ set timeout [target_info gdb_reverse_timeout]
+ }
+
+ # If GDB_INOTIFY is given, check for writes to '.'. This is a
+ # debugging tool to help confirm that the test suite is
+ # parallel-safe. You need "inotifywait" from the
+ # inotify-tools package to use this.
+ global GDB_INOTIFY inotify_pid
+ if {[info exists GDB_INOTIFY] && ![info exists inotify_pid]} {
+ global outdir tool inotify_log_file
+
+ set exclusions {outputs temp gdb[.](log|sum) cache}
+ set exclusion_re ([join $exclusions |])
+
+ set inotify_log_file [standard_temp_file inotify.out]
+ set inotify_pid [exec inotifywait -r -m -e move,create,delete . \
+ --exclude $exclusion_re \
+ |& tee -a $outdir/$tool.log $inotify_log_file &]
+
+ # Wait for the watches; hopefully this is long enough.
+ sleep 2
+
+ # Clear the log so that we don't emit a warning the first time
+ # we check it.
+ set fd [open $inotify_log_file w]
+ close $fd
+ }
+
+ # Block writes to all banned variables, and invocation of all
+ # banned procedures...
+ global banned_variables
+ global banned_procedures
+ global banned_traced
+ if (!$banned_traced) {
+ foreach banned_var $banned_variables {
+ global "$banned_var"
+ trace add variable "$banned_var" write error
+ }
+ foreach banned_proc $banned_procedures {
+ global "$banned_proc"
+ trace add execution "$banned_proc" enter error
+ }
+ set banned_traced 1
+ }
+
+ # We set LC_ALL, LC_CTYPE, and LANG to C so that we get the same
+ # messages as expected.
+ setenv LC_ALL C
+ setenv LC_CTYPE C
+ setenv LANG C
+
+ # Don't let a .inputrc file or an existing setting of INPUTRC mess up
+ # the test results. Even if /dev/null doesn't exist on the particular
+ # platform, the readline library will use the default setting just by
+ # failing to open the file. OTOH, opening /dev/null successfully will
+ # also result in the default settings being used since nothing will be
+ # read from this file.
+ setenv INPUTRC "/dev/null"
+
+ # This disables style output, which would interfere with many
+ # tests.
+ setenv TERM "dumb"
+
+ # Ensure that GDBHISTFILE and GDBHISTSIZE are removed from the
+ # environment, we don't want these modifications to the history
+ # settings.
+ unset -nocomplain ::env(GDBHISTFILE)
+ unset -nocomplain ::env(GDBHISTSIZE)
+
+ # Initialize GDB's pty with a fixed size, to make sure we avoid pagination
+ # during startup. See "man expect" for details about stty_init.
+ global stty_init
+ set stty_init "rows 25 cols 80"
+
+ # Some tests (for example gdb.base/maint.exp) shell out from gdb to use
+ # grep. Clear GREP_OPTIONS to make the behavior predictable,
+ # especially having color output turned on can cause tests to fail.
+ setenv GREP_OPTIONS ""
+
+ # Clear $gdbserver_reconnect_p.
+ global gdbserver_reconnect_p
+ set gdbserver_reconnect_p 1
+ unset gdbserver_reconnect_p
+
+ # Clear $last_loaded_file
+ global last_loaded_file
+ unset -nocomplain last_loaded_file
+
+ # Reset GDB number of instances
+ global gdb_instances
+ set gdb_instances 0
+
set cleanfiles {}
gdb_clear_suppressed
if [info exists use_gdb_stub] {
unset use_gdb_stub
}
+
+ gdb_setup_known_globals
+
+ if { [info procs ::gdb_tcl_unknown] != "" } {
+ # Dejagnu overrides proc unknown. The dejagnu version may trigger in a
+ # test-case but abort the entire test run. To fix this, we install a
+ # local version here, which reverts dejagnu's override, and restore
+ # dejagnu's version in gdb_finish.
+ rename ::unknown ::dejagnu_unknown
+ proc unknown { args } {
+ # Use tcl's unknown.
+ set cmd [lindex $args 0]
+ unresolved "testcase aborted due to invalid command name: $cmd"
+ return [uplevel 1 ::gdb_tcl_unknown $args]
+ }
+ }
}
# Return a path using GDB_PARALLEL.
file mkdir $dir
# If running on MinGW, replace /c/foo with c:/foo
if { [ishost *-*-mingw*] } {
- set dir [regsub {^/([a-z])/} $dir {\1:/}]
+ set dir [exec sh -c "cd ${dir} && pwd -W"]
}
return [file join $dir $basename]
}
return [file join $dir $basename]
}
+# Rename file A to file B, if B does not already exists. Otherwise, leave B
+# as is and delete A. Return 1 if rename happened.
+
+proc tentative_rename { a b } {
+ global errorInfo errorCode
+ set code [catch {file rename -- $a $b} result]
+ if { $code == 1 && [lindex $errorCode 0] == "POSIX" \
+ && [lindex $errorCode 1] == "EEXIST" } {
+ file delete $a
+ return 0
+ }
+ if {$code == 1} {
+ return -code error -errorinfo $errorInfo -errorcode $errorCode $result
+ } elseif {$code > 1} {
+ return -code $code $result
+ }
+ return 1
+}
+
+# Create a file with name FILENAME and contents TXT in the cache directory.
+# If EXECUTABLE, mark the new file for execution.
+
+proc cached_file { filename txt {executable 0}} {
+ set filename [make_gdb_parallel_path cache $filename]
+
+ if { [file exists $filename] } {
+ return $filename
+ }
+
+ set dir [file dirname $filename]
+ file mkdir $dir
+
+ set tmp_filename $filename.[pid]
+ set fd [open $tmp_filename w]
+ puts $fd $txt
+ close $fd
+
+ if { $executable } {
+ exec chmod +x $tmp_filename
+ }
+ tentative_rename $tmp_filename $filename
+
+ return $filename
+}
+
# Set 'testfile', 'srcfile', and 'binfile'.
#
# ARGS is a list of source file specifications.
# if the banned variables and procedures are already traced.
set banned_traced 0
-proc gdb_init { test_file_name } {
- # 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 gdb_test_timeout
- global timeout
- set timeout $gdb_test_timeout
-
- if { [regexp ".*gdb\.reverse\/.*" $test_file_name]
- && [target_info exists gdb_reverse_timeout] } {
- set timeout [target_info gdb_reverse_timeout]
- }
-
- # If GDB_INOTIFY is given, check for writes to '.'. This is a
- # debugging tool to help confirm that the test suite is
- # parallel-safe. You need "inotifywait" from the
- # inotify-tools package to use this.
- global GDB_INOTIFY inotify_pid
- if {[info exists GDB_INOTIFY] && ![info exists inotify_pid]} {
- global outdir tool inotify_log_file
-
- set exclusions {outputs temp gdb[.](log|sum) cache}
- set exclusion_re ([join $exclusions |])
-
- set inotify_log_file [standard_temp_file inotify.out]
- set inotify_pid [exec inotifywait -r -m -e move,create,delete . \
- --exclude $exclusion_re \
- |& tee -a $outdir/$tool.log $inotify_log_file &]
+# Global array that holds the name of all global variables at the time
+# a test script is started. After the test script has completed any
+# global not in this list is deleted.
+array set gdb_known_globals {}
- # Wait for the watches; hopefully this is long enough.
- sleep 2
+# Setup the GDB_KNOWN_GLOBALS array with the names of all current
+# global variables.
+proc gdb_setup_known_globals {} {
+ global gdb_known_globals
- # Clear the log so that we don't emit a warning the first time
- # we check it.
- set fd [open $inotify_log_file w]
- close $fd
+ array set gdb_known_globals {}
+ foreach varname [info globals] {
+ set gdb_known_globals($varname) 1
}
+}
- # Block writes to all banned variables, and invocation of all
- # banned procedures...
- global banned_variables
- global banned_procedures
- global banned_traced
- if (!$banned_traced) {
- foreach banned_var $banned_variables {
- global "$banned_var"
- trace add variable "$banned_var" write error
- }
- foreach banned_proc $banned_procedures {
- global "$banned_proc"
- trace add execution "$banned_proc" enter error
+# Cleanup the global namespace. Any global not in the
+# GDB_KNOWN_GLOBALS array is unset, this ensures we don't "leak"
+# globals from one test script to another.
+proc gdb_cleanup_globals {} {
+ global gdb_known_globals gdb_persistent_globals
+
+ foreach varname [info globals] {
+ if {![info exists gdb_known_globals($varname)]} {
+ if { [info exists gdb_persistent_globals($varname)] } {
+ continue
+ }
+ uplevel #0 unset $varname
}
- set banned_traced 1
}
+}
- # We set LC_ALL, LC_CTYPE, and LANG to C so that we get the same
- # messages as expected.
- setenv LC_ALL C
- setenv LC_CTYPE C
- setenv LANG C
-
- # Don't let a .inputrc file or an existing setting of INPUTRC mess up
- # the test results. Even if /dev/null doesn't exist on the particular
- # platform, the readline library will use the default setting just by
- # failing to open the file. OTOH, opening /dev/null successfully will
- # also result in the default settings being used since nothing will be
- # read from this file.
- setenv INPUTRC "/dev/null"
-
- # This disables style output, which would interfere with many
- # tests.
- setenv TERM "dumb"
-
- # Initialize GDB's pty with a fixed size, to make sure we avoid pagination
- # during startup. See "man expect" for details about stty_init.
- global stty_init
- set stty_init "rows 25 cols 80"
-
- # Some tests (for example gdb.base/maint.exp) shell out from gdb to use
- # grep. Clear GREP_OPTIONS to make the behavior predictable,
- # especially having color output turned on can cause tests to fail.
- setenv GREP_OPTIONS ""
-
- # Clear $gdbserver_reconnect_p.
- global gdbserver_reconnect_p
- set gdbserver_reconnect_p 1
- unset gdbserver_reconnect_p
-
- # Reset GDB number of instances
- global gdb_instances
- set gdb_instances 0
+# Create gdb_tcl_unknown, a copy tcl's ::unknown, provided it's present as a
+# proc.
+set temp [interp create]
+if { [interp eval $temp "info procs ::unknown"] != "" } {
+ set old_args [interp eval $temp "info args ::unknown"]
+ set old_body [interp eval $temp "info body ::unknown"]
+ eval proc gdb_tcl_unknown {$old_args} {$old_body}
+}
+interp delete $temp
+unset temp
- return [default_gdb_init $test_file_name]
+# GDB implementation of ${tool}_init. Called right before executing the
+# test-case.
+# Overridable function -- you can override this function in your
+# baseboard file.
+proc gdb_init { args } {
+ # A baseboard file overriding this proc and calling the default version
+ # should behave the same as this proc. So, don't add code here, but to
+ # the default version instead.
+ return [default_gdb_init {*}$args]
}
+# GDB implementation of ${tool}_finish. Called right after executing the
+# test-case.
proc gdb_finish { } {
global gdbserver_reconnect_p
global gdb_prompt
global cleanfiles
+ global known_globals
+
+ if { [info procs ::gdb_tcl_unknown] != "" } {
+ # Restore dejagnu's version of proc unknown.
+ rename ::unknown ""
+ rename ::dejagnu_unknown ::unknown
+ }
# Exit first, so that the files are no longer in use.
gdb_exit
}
set banned_traced 0
}
+
+ global gdb_finish_hooks
+ foreach gdb_finish_hook $gdb_finish_hooks {
+ $gdb_finish_hook
+ }
+ set gdb_finish_hooks [list]
+
+ gdb_cleanup_globals
}
global debug_format
proc get_debug_format { } {
global gdb_prompt
- global verbose
global expect_out
global debug_format
return -1
}
set readelf_program [gdb_find_readelf]
- set res [catch {exec $readelf_program -d $executable} output]
+ # We're not testing readelf -d | grep "FLAGS_1.*Flags:.*PIE"
+ # because the PIE flag is not set by all versions of gold, see PR
+ # binutils/26039.
+ set res [catch {exec $readelf_program -h $executable} output]
if { $res != 0 } {
return -1
}
- set res [regexp -line {\(FLAGS_1\).*Flags:.* PIE($| )} $output]
+ set res [regexp -line {^[ \t]*Type:[ \t]*DYN \(Shared object file\)$} \
+ $output]
if { $res == 1 } {
return 1
}
# Starts fresh GDB binary and loads an optional executable into GDB.
# Usage: clean_restart [executable]
# EXECUTABLE is the basename of the binary.
+# Return -1 if starting gdb or loading the executable failed.
proc clean_restart { args } {
global srcdir
global subdir
+ global errcnt
+ global warncnt
if { [llength $args] > 1 } {
error "bad number of args: [llength $args]"
}
gdb_exit
+
+ # This is a clean restart, so reset error and warning count.
+ set errcnt 0
+ set warncnt 0
+
+ # We'd like to do:
+ # if { [gdb_start] == -1 } {
+ # return -1
+ # }
+ # but gdb_start is a ${tool}_start proc, which doesn't have a defined
+ # return value. So instead, we test for errcnt.
gdb_start
+ if { $errcnt > 0 } {
+ return -1
+ }
+
gdb_reinitialize_dir $srcdir/$subdir
if { [llength $args] >= 1 } {
set executable [lindex $args 0]
set binfile [standard_output_file ${executable}]
- gdb_load ${binfile}
+ return [gdb_load ${binfile}]
}
+
+ return 0
}
# Prepares for testing by calling build_executable_full, then
return ${val}
}
+# Retrieve the value of local var EXP in the inferior. DEFAULT is used as
+# fallback if print fails. TEST is the test message to use. It can be
+# omitted, in which case a test message is built from EXP.
+
+proc get_local_valueof { exp default {test ""} } {
+ global gdb_prompt
+
+ if {$test == "" } {
+ set test "get local valueof \"${exp}\""
+ }
+
+ set val ${default}
+ gdb_test_multiple "info locals ${exp}" "$test" {
+ -re "$exp = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" {
+ set val $expect_out(1,string)
+ pass "$test"
+ }
+ timeout {
+ fail "$test (timeout)"
+ }
+ }
+ return ${val}
+}
+
# Retrieve the value of EXP in the inferior, as a signed decimal value
# (using "print /d"). DEFAULT is used as fallback if print fails.
# TEST is the test message to use. It can be omitted, in which case
# Open the file for logging gdb input
proc gdb_stdin_log_init { } {
- global in_file
+ gdb_persistent_global in_file
if {[info exists in_file]} {
# Close existing file.
}
# Does the compiler support CTF debug output using '-gt' compiler
-# flag? If not then we should skip these tests.
+# flag? If not then we should skip these tests. We should also
+# skip them if libctf was explicitly disabled.
gdb_caching_proc skip_ctf_tests {
+ global enable_libctf
+
+ if {$enable_libctf eq "no"} {
+ return 1
+ }
+
return ![gdb_can_simple_compile ctfdebug {
int main () {
return 0;
} executable "additional_flags=-gt"]
}
+# Return 1 if compiler supports -gstatement-frontiers. Otherwise,
+# return 0.
+
+gdb_caching_proc supports_statement_frontiers {
+ return [gdb_can_simple_compile supports_statement_frontiers {
+ int main () {
+ return 0;
+ }
+ } executable "additional_flags=-gstatement-frontiers"]
+}
+
+# Return 1 if compiler supports -mmpx -fcheck-pointer-bounds. Otherwise,
+# return 0.
+
+gdb_caching_proc supports_mpx_check_pointer_bounds {
+ set flags "additional_flags=-mmpx additional_flags=-fcheck-pointer-bounds"
+ return [gdb_can_simple_compile supports_mpx_check_pointer_bounds {
+ int main () {
+ return 0;
+ }
+ } executable $flags]
+}
+
+# Return 1 if compiler supports -fcf-protection=. Otherwise,
+# return 0.
+
+gdb_caching_proc supports_fcf_protection {
+ return [gdb_can_simple_compile supports_fcf_protection {
+ int main () {
+ return 0;
+ }
+ } executable "additional_flags=-fcf-protection=full"]
+}
+
+# Return 1 if symbols were read in using -readnow. Otherwise, return 0.
+
+proc readnow { } {
+ set cmd "maint print objfiles"
+ gdb_test_multiple $cmd "" {
+ -re -wrap "\r\n.gdb_index: faked for \"readnow\"\r\n.*" {
+ return 1
+ }
+ -re -wrap "" {
+ return 0
+ }
+ }
+
+ return 0
+}
+
+# Return 1 if partial symbols are available. Otherwise, return 0.
+
+proc psymtabs_p { } {
+ global gdb_prompt
+
+ set cmd "maint info psymtab"
+ gdb_test_multiple $cmd "" {
+ -re "$cmd\r\n$gdb_prompt $" {
+ return 0
+ }
+ -re -wrap "" {
+ return 1
+ }
+ }
+
+ return 0
+}
+
+# Verify that partial symtab expansion for $filename has state $readin.
+
+proc verify_psymtab_expanded { filename readin } {
+ global gdb_prompt
+
+ set cmd "maint info psymtab"
+ set test "$cmd: $filename: $readin"
+ set re [multi_line \
+ " \{ psymtab \[^\r\n\]*$filename\[^\r\n\]*" \
+ " readin $readin" \
+ ".*"]
+
+ gdb_test_multiple $cmd $test {
+ -re "$cmd\r\n$gdb_prompt $" {
+ unsupported $gdb_test_name
+ }
+ -re -wrap $re {
+ pass $gdb_test_name
+ }
+ }
+}
+
+# Add a .gdb_index section to PROGRAM.
+# PROGRAM is assumed to be the output of standard_output_file.
+# Returns the 0 if there is a failure, otherwise 1.
+
+proc add_gdb_index { program } {
+ global srcdir GDB env BUILD_DATA_DIRECTORY
+ set contrib_dir "$srcdir/../contrib"
+ set env(GDB) "$GDB --data-directory=$BUILD_DATA_DIRECTORY"
+ set result [catch "exec $contrib_dir/gdb-add-index.sh $program" output]
+ if { $result != 0 } {
+ verbose -log "result is $result"
+ verbose -log "output is $output"
+ return 0
+ }
+
+ return 1
+}
+
+# Add a .gdb_index section to PROGRAM, unless it alread has an index
+# (.gdb_index/.debug_names). Gdb doesn't support building an index from a
+# program already using one. Return 1 if a .gdb_index was added, return 0
+# if it already contained an index, and -1 if an error occurred.
+
+proc ensure_gdb_index { binfile } {
+ set testfile [file tail $binfile]
+ set test "check if index present"
+ gdb_test_multiple "mt print objfiles ${testfile}" $test {
+ -re -wrap "gdb_index.*" {
+ return 0
+ }
+ -re -wrap "debug_names.*" {
+ return 0
+ }
+ -re -wrap "Psymtabs.*" {
+ if { [add_gdb_index $binfile] != "1" } {
+ return -1
+ }
+ return 1
+ }
+ }
+ return -1
+}
+
+# Return 1 if executable contains .debug_types section. Otherwise, return 0.
+
+proc debug_types { } {
+ global hex
+
+ set cmd "maint info sections"
+ gdb_test_multiple $cmd "" {
+ -re -wrap "at $hex: .debug_types.*" {
+ return 1
+ }
+ -re -wrap "" {
+ return 0
+ }
+ }
+
+ return 0
+}
+
+# Return the addresses in the line table for FILE for which is_stmt is true.
+
+proc is_stmt_addresses { file } {
+ global decimal
+ global hex
+
+ set is_stmt [list]
+
+ gdb_test_multiple "maint info line-table $file" "" {
+ -re "\r\n$decimal\[ \t\]+$decimal\[ \t\]+($hex)\[ \t\]+Y\[^\r\n\]*" {
+ lappend is_stmt $expect_out(1,string)
+ exp_continue
+ }
+ -re -wrap "" {
+ }
+ }
+
+ return $is_stmt
+}
+
+# Return 1 if hex number VAL is an element of HEXLIST.
+
+proc hex_in_list { val hexlist } {
+ # Normalize val by removing 0x prefix, and leading zeros.
+ set val [regsub ^0x $val ""]
+ set val [regsub ^0+ $val "0"]
+
+ set re 0x0*$val
+ set index [lsearch -regexp $hexlist $re]
+ return [expr $index != -1]
+}
+
+# Override proc NAME to proc OVERRIDE for the duration of the execution of
+# BODY.
+
+proc with_override { name override body } {
+ # Implementation note: It's possible to implement the override using
+ # rename, like this:
+ # rename $name save_$name
+ # rename $override $name
+ # set code [catch {uplevel 1 $body} result]
+ # rename $name $override
+ # rename save_$name $name
+ # but there are two issues here:
+ # - the save_$name might clash with an existing proc
+ # - the override is no longer available under its original name during
+ # the override
+ # So, we use this more elaborate but cleaner mechanism.
+
+ # Save the old proc.
+ set old_args [info args $name]
+ set old_body [info body $name]
+
+ # Install the override.
+ set new_args [info args $override]
+ set new_body [info body $override]
+ eval proc $name {$new_args} {$new_body}
+
+ # Execute body.
+ set code [catch {uplevel 1 $body} result]
+
+ # Restore old proc.
+ eval proc $name {$old_args} {$old_body}
+
+ # Return as appropriate.
+ if { $code == 1 } {
+ global errorInfo errorCode
+ return -code error -errorinfo $errorInfo -errorcode $errorCode $result
+ } elseif { $code > 1 } {
+ return -code $code $result
+ }
+
+ return $result
+}
+
+# Setup tuiterm.exp environment. To be used in test-cases instead of
+# "load_lib tuiterm.exp". Calls initialization function and schedules
+# finalization function.
+proc tuiterm_env { } {
+ load_lib tuiterm.exp
+
+ # Do initialization.
+ tuiterm_env_init
+
+ # Schedule finalization.
+ global gdb_finish_hooks
+ lappend gdb_finish_hooks tuiterm_env_finish
+}
+
+# Dejagnu has a version of note, but usage is not allowed outside of dejagnu.
+# Define a local version.
+proc gdb_note { message } {
+ verbose -- "NOTE: $message" 0
+}
+
+# Return 1 if compiler supports -fuse-ld=gold, otherwise return 0.
+gdb_caching_proc have_fuse_ld_gold {
+ set me "have_fuse_ld_gold"
+ set flags "additional_flags=-fuse-ld=gold"
+ set src { int main() { return 0; } }
+ return [gdb_simple_compile $me $src executable $flags]
+}
+
# Always load compatibility stuff.
load_lib future.exp
projects / deliverable / binutils-gdb.git / blobdiff