-# Copyright 1992-2015 Free Software Foundation, Inc.
+# Copyright 1992-2019 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
load_lib libgloss.exp
load_lib cache.exp
load_lib gdb-utils.exp
+load_lib memory.exp
global GDB
}
# A regexp that matches the pagination prompt.
-set pagination_prompt [string_to_regexp "---Type <return> to continue, or q <return> to quit---"]
+set pagination_prompt \
+ "--Type <RET> for more, q to quit, c to continue without paging--"
# The variable fullname_syntax_POSIX is a regexp which matches a POSIX
# absolute path ie. /foo/
set inferior_exited_re "(\\\[Inferior \[0-9\]+ \\(.*\\) exited)"
+# A regular expression that matches a value history number.
+# E.g., $1, $2, etc.
+set valnum_re "\\\$$decimal"
+
### Only procedures should come after this point.
#
}
}
+# Returns true iff the target supports using the "run" command.
+
+proc target_can_use_run_cmd {} {
+ if [target_info exists use_gdb_stub] {
+ # In this case, when we connect, the inferior is already
+ # running.
+ return 0
+ }
+
+ # Assume yes.
+ return 1
+}
+
# Generic run command.
#
# The second pattern below matches up to the first newline *only*.
return -1
}
+# Generic starti command. Return 0 if we could start the program, -1
+# if we could not.
+#
+# 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} {
+ global gdb_prompt use_gdb_stub
+
+ foreach command [gdb_init_commands] {
+ send_gdb "$command\n"
+ gdb_expect 30 {
+ -re "$gdb_prompt $" { }
+ default {
+ perror "gdb_init_command for target failed"
+ return -1
+ }
+ }
+ }
+
+ if $use_gdb_stub {
+ return -1
+ }
+
+ send_gdb "starti $args\n"
+ gdb_expect 60 {
+ -re "The program .* has been started already.*y or n. $" {
+ send_gdb "y\n"
+ exp_continue
+ }
+ -re "Starting program: \[^\r\n\]*" {
+ return 0
+ }
+ }
+ return -1
+}
+
# Set a breakpoint at FUNCTION. If there is an additional argument it is
# a list of options; the supported options are allow-pending, temporary,
-# message, no-message, and passfail.
+# message, no-message, passfail and qualified.
# The result is 1 for success, 0 for failure.
#
# Note: The handling of message vs no-message is messed up, but it's based
set break_message "Temporary breakpoint"
}
+ if {[lsearch -exact $args qualified] != -1} {
+ append break_command " -qualified"
+ }
+
set print_pass 0
set print_fail 1
set no_message_loc [lsearch -exact $args no-message]
}
-re "The target does not support running in non-stop mode.\r\n$gdb_prompt $" {
if { $print_fail } {
- unsupported "Non-stop mode not supported"
+ unsupported "non-stop mode not supported"
}
return 0
}
}
}
append code $processed_code
+
+ # Reset the spawn id, in case the processed code used -i.
append code {
- # Reset the spawn id, in case the processed code used -i.
-i "$gdb_spawn_id"
+ }
+ append code {
-re "Ending remote debugging.*$gdb_prompt $" {
if ![isnative] then {
warning "Can`t communicate to remote target."
set result -1
}
- # Patterns below apply to any spawn id specified.
+ -i $gdb_spawn_id
+ eof {
+ perror "GDB process no longer exists"
+ set wait_status [wait -i $gdb_spawn_id]
+ verbose -log "GDB process exited with wait status $wait_status"
+ if { $message != "" } {
+ fail "$message"
+ }
+ return -1
+ }
+ }
+
+ # Now patterns that apply to any spawn id specified.
+ append code {
-i $any_spawn_id
eof {
perror "Process no longer exists"
}
}
+ # remote_expect calls the eof section if there is an error on the
+ # expect call. We already have eof sections above, and we don't
+ # want them to get called in that situation. Since the last eof
+ # section becomes the error section, here we define another eof
+ # section, but with an empty spawn_id list, so that it won't ever
+ # match.
+ append code {
+ -i "" eof {
+ # This comment is here because the eof section must not be
+ # the empty string, otherwise remote_expect won't realize
+ # it exists.
+ }
+ }
+
set result 0
set code [catch {gdb_expect $code} string]
if {$code == 1} {
# COMMAND is the command to execute, send to GDB with send_gdb. If
# this is the null string no command is sent.
# PATTERN is the pattern to match for a PASS, and must NOT include
-# the \r\n sequence immediately before the gdb prompt.
+# the \r\n sequence immediately before the gdb prompt. This argument
+# may be omitted to just match the prompt, ignoring whatever output
+# precedes it.
# MESSAGE is an optional message to be printed. If this is
# omitted, then the pass/fail messages use the command string as the
# message. (If this is the empty string, then sometimes we don't
# -1 if there was an internal error.
#
proc gdb_test { args } {
- global verbose
global gdb_prompt
- global GDB
upvar timeout timeout
if [llength $args]>2 then {
}
return [gdb_test_multiple $command $message {
- -re "\[\r\n\]*($pattern)\[\r\n\]+$gdb_prompt $" {
+ -re "\[\r\n\]*(?:$pattern)\[\r\n\]+$gdb_prompt $" {
if ![string match "" $message] then {
pass "$message"
}
# This is useful when the sequence is long and contains ".*", a single
# regexp to match the entire output can get a timeout much easier.
#
-# COMMAND is the command to send.
+# COMMAND is the command to execute, send to GDB with send_gdb. If
+# this is the null string no command is sent.
# TEST_NAME is passed to pass/fail. COMMAND is used if TEST_NAME is "".
# EXPECTED_OUTPUT_LIST is a list of regexps of expected output, which are
# processed in order, and all must be present in the output.
set test_name $command
}
lappend expected_output_list ""; # implicit ".*" before gdb prompt
- send_gdb "$command\n"
+ if { $command != "" } {
+ send_gdb "$command\n"
+ }
return [gdb_expect_list $test_name "$gdb_prompt $" $expected_output_list]
}
}
}
}
+
+# 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
global GDB
global INTERNAL_GDBFLAGS GDBFLAGS
global verbose
- global gdb_spawn_id
+ global gdb_spawn_id inferior_spawn_id
global inotify_log_file
gdb_stop_suppressing_tests
remote_close host
}
unset gdb_spawn_id
+ unset inferior_spawn_id
}
# Load a file into the debugger.
send_gdb "file $arg\n"
gdb_expect 120 {
- -re "Reading symbols from.*LZMA support was disabled.*done.*$gdb_prompt $" {
+ -re "Reading symbols from.*LZMA support was disabled.*$gdb_prompt $" {
verbose "\t\tLoaded $arg into $GDB; .gnu_debugdata found but no LZMA available"
set gdb_file_cmd_debug_info "lzma"
return 0
}
- -re "Reading symbols from.*no debugging symbols found.*done.*$gdb_prompt $" {
+ -re "Reading symbols from.*no debugging symbols found.*$gdb_prompt $" {
verbose "\t\tLoaded $arg into $GDB with no debugging symbols"
set gdb_file_cmd_debug_info "nodebug"
return 0
}
- -re "Reading symbols from.*done.*$gdb_prompt $" {
+ -re "Reading symbols from.*$gdb_prompt $" {
verbose "\t\tLoaded $arg into $GDB"
set gdb_file_cmd_debug_info "debug"
return 0
-re "Load new symbol table from \".*\".*y or n. $" {
send_gdb "y\n"
gdb_expect 120 {
- -re "Reading symbols from.*done.*$gdb_prompt $" {
+ -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
# Default gdb_start procedure.
proc default_gdb_start { } {
- global gdb_prompt pagination_prompt
+ global gdb_prompt
global gdb_spawn_id
global inferior_spawn_id
# When running over NFS, particularly if running many simultaneous
# tests on different hosts all using the same server, things can
# get really slow. Give gdb at least 3 minutes to start up.
- set loop_again 1
- while { $loop_again } {
- set loop_again 0
- gdb_expect 360 {
- -re "$pagination_prompt" {
- verbose "Hit pagination during startup. Pressing enter to continue."
- send_gdb "\n"
- set loop_again 1
- }
- -re "\[\r\n\]$gdb_prompt $" {
- verbose "GDB initialized."
- }
- -re "$gdb_prompt $" {
- perror "GDB never initialized."
- unset gdb_spawn_id
- return -1
- }
- timeout {
- perror "(timeout) GDB never initialized after 10 seconds."
- remote_close host
- unset gdb_spawn_id
- return -1
- }
+ gdb_expect 360 {
+ -re "\[\r\n\]$gdb_prompt $" {
+ verbose "GDB initialized."
+ }
+ -re "$gdb_prompt $" {
+ perror "GDB never initialized."
+ unset gdb_spawn_id
+ return -1
+ }
+ timeout {
+ perror "(timeout) GDB never initialized after 10 seconds."
+ remote_close host
+ unset gdb_spawn_id
+ return -1
}
}
return 0
}
-# Return a 1 if I don't even want to try to test java.
-
-proc skip_java_tests {} {
- return 0
-}
-
# Return a 1 if I don't even want to try to test D.
proc skip_d_tests {} {
return 0
}
+# Return 1 to skip Rust tests, 0 to try them.
+proc skip_rust_tests {} {
+ return [expr {![isnative]}]
+}
+
# 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 $" {
- set gdb_py_is_py24 1
- }
- -re ".*$gdb_prompt $" {
- 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 {} {
}
}
+# Wrapper for foreach that calls with_test_prefix on each iteration,
+# including the iterator's name and current value in the prefix.
+
+proc foreach_with_prefix {var list body} {
+ upvar 1 $var myvar
+ foreach myvar $list {
+ with_test_prefix "$var=$myvar" {
+ uplevel 1 $body
+ }
+ }
+}
+
+# Like TCL's native proc, but defines a procedure that wraps its body
+# within 'with_test_prefix "$proc_name" { ... }'.
+proc proc_with_prefix {name arguments body} {
+ # Define the advertised proc.
+ proc $name $arguments [list with_test_prefix $name $body]
+}
+
+
+# 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 the current working directory (CWD) set to
+# DIR. When BODY is finished, restore the original CWD. Return the
+# result of BODY.
+#
+# This procedure doesn't check if DIR is a valid directory, so you
+# have to make sure of that.
+
+proc with_cwd { dir body } {
+ set saved_dir [pwd]
+ verbose -log "Switching to directory $dir (saved CWD: $saved_dir)."
+ cd $dir
+
+ set code [catch {uplevel 1 $body} result]
+
+ verbose -log "Switching back to $saved_dir."
+ cd $saved_dir
+
+ 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.
}
}
+# Switch the default spawn id to SPAWN_ID, so that gdb_test,
+# mi_gdb_test etc. default to using it.
+
+proc switch_gdb_spawn_id {spawn_id} {
+ global gdb_spawn_id
+ global board board_info
+
+ set gdb_spawn_id $spawn_id
+ set board [host_info name]
+ set board_info($board,fileid) $spawn_id
+}
+
+# Clear the default spawn id.
+
+proc clear_gdb_spawn_id {} {
+ global gdb_spawn_id
+ global board board_info
+
+ unset -nocomplain gdb_spawn_id
+ set board [host_info name]
+ unset -nocomplain board_info($board,fileid)
+}
+
+# Run BODY with SPAWN_ID as current spawn id.
+
+proc with_spawn_id { spawn_id body } {
+ global gdb_spawn_id
+
+ if [info exists gdb_spawn_id] {
+ set saved_spawn_id $gdb_spawn_id
+ }
+
+ switch_gdb_spawn_id $spawn_id
+
+ set code [catch {uplevel 1 $body} result]
+
+ if [info exists saved_spawn_id] {
+ switch_gdb_spawn_id $saved_spawn_id
+ } else {
+ clear_gdb_spawn_id
+ }
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
# Select the largest timeout from all the timeouts:
# - the local "timeout" variable of the scope two levels above,
# - the global "timeout" variable,
# Return 1 if _Complex types are supported, otherwise, return 0.
gdb_caching_proc support_complex_tests {
- # Set up, compile, and execute a test program containing _Complex types.
- # Include the current process ID in the file names to prevent conflicts
- # with invocations for multiple testsuites.
- set src [standard_temp_file complex[pid].c]
- set exe [standard_temp_file complex[pid].x]
- gdb_produce_source $src {
+ if { [gdb_skip_float_test] } {
+ # If floating point is not supported, _Complex is not
+ # supported.
+ return 0
+ }
+
+ # Compile a test program containing _Complex types.
+
+ return [gdb_can_simple_compile complex {
int main() {
_Complex float cf;
_Complex double cd;
_Complex long double cld;
return 0;
}
- }
-
- verbose "compiling testfile $src" 2
- set compile_flags {debug nowarnings quiet}
- set lines [gdb_compile $src $exe executable $compile_flags]
- file delete $src
- file delete $exe
-
- if ![string match "" $lines] then {
- verbose "testfile compilation failed, returning 0" 2
- set result 0
- } else {
- set result 1
- }
-
- return $result
+ } executable]
}
# Return 1 if GDB can get a type for siginfo from the target, otherwise
}
}
-# 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
}
gdb_caching_proc is_elf_target {
set me "is_elf_target"
- set src [standard_temp_file is_elf_target[pid].c]
- set obj [standard_temp_file is_elf_target[pid].o]
-
- gdb_produce_source $src {
- int foo () {return 0;}
- }
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
-
- file delete $src
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
+ set src { int foo () {return 0;} }
+ if {![gdb_simple_compile elf_target $src]} {
+ return 0
}
set fp_obj [open $obj "r"]
# This cannot be decided simply from looking at the target string,
# as it might depend on externally passed compiler options like -m64.
gdb_caching_proc is_ilp32_target {
- set me "is_ilp32_target"
-
- set src [standard_temp_file ilp32[pid].c]
- set obj [standard_temp_file ilp32[pid].o]
-
- gdb_produce_source $src {
+ return [gdb_can_simple_compile is_ilp32_target {
int dummy[sizeof (int) == 4
&& sizeof (void *) == 4
&& sizeof (long) == 4 ? 1 : -1];
- }
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
- file delete $src
- file delete $obj
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
- }
-
- verbose "$me: returning 1" 2
- return 1
-}
+ }]
+}
# Return 1 if target is LP64.
# This cannot be decided simply from looking at the target string,
# as it might depend on externally passed compiler options like -m64.
gdb_caching_proc is_lp64_target {
- set me "is_lp64_target"
-
- set src [standard_temp_file lp64[pid].c]
- set obj [standard_temp_file lp64[pid].o]
-
- gdb_produce_source $src {
+ return [gdb_can_simple_compile is_lp64_target {
int dummy[sizeof (int) == 4
&& sizeof (void *) == 8
&& sizeof (long) == 8 ? 1 : -1];
- }
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
- file delete $src
- file delete $obj
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
- }
-
- verbose "$me: returning 1" 2
- return 1
+ }]
}
# Return 1 if target has 64 bit addresses.
# This cannot be decided simply from looking at the target string,
# as it might depend on externally passed compiler options like -m64.
gdb_caching_proc is_64_target {
- set me "is_64_target"
-
- set src [standard_temp_file is64[pid].c]
- set obj [standard_temp_file is64[pid].o]
-
- gdb_produce_source $src {
+ return [gdb_can_simple_compile is_64_target {
int function(void) { return 3; }
int dummy[sizeof (&function) == 8 ? 1 : -1];
- }
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
- file delete $src
- file delete $obj
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
- }
-
- verbose "$me: returning 1" 2
- return 1
+ }]
}
# Return 1 if target has x86_64 registers - either amd64 or x32.
return 0
}
- set me "is_amd64_regs_target"
+ return [gdb_can_simple_compile is_amd64_regs_target {
+ int main (void) {
+ asm ("incq %rax");
+ asm ("incq %r15");
- set src [standard_temp_file reg64[pid].s]
- set obj [standard_temp_file reg64[pid].o]
-
- set list {}
- foreach reg \
- {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
- lappend list "\tincq %$reg"
+ return 0;
}
- gdb_produce_source $src [join $list \n]
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
- file delete $src
- file delete $obj
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
- }
-
- verbose "$me: returning 1" 2
- return 1
+ }]
}
# Return 1 if this target is an x86 or x86-64 with -m32.
return 0
}
- set me "is_aarch32_target"
-
- set src [standard_temp_file aarch32[pid].s]
- set obj [standard_temp_file aarch32[pid].o]
-
set list {}
foreach reg \
{r0 r1 r2 r3} {
lappend list "\tmov $reg, $reg"
}
- gdb_produce_source $src [join $list \n]
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $obj object {quiet}]
- file delete $src
- file delete $obj
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 0" 2
- return 0
- }
-
- verbose "$me: returning 1" 2
- return 1
+ return [gdb_can_simple_compile aarch32 [join $list \n]]
}
# Return 1 if this target is an aarch64, either lp64 or ilp32.
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
}
}
# Make sure we have a compiler that understands altivec.
- set compile_flags {debug nowarnings}
if [get_compiler_info] {
warning "Could not get compiler info"
return 1
}
if [test_compiler_info gcc*] {
- set compile_flags "$compile_flags additional_flags=-maltivec"
+ set compile_flags "additional_flags=-maltivec"
} elseif [test_compiler_info xlc*] {
- set compile_flags "$compile_flags additional_flags=-qaltivec"
+ set compile_flags "additional_flags=-qaltivec"
} else {
verbose "Could not compile with altivec support, returning 1" 2
return 1
}
- # Set up, compile, and execute a test program containing VMX instructions.
- # Include the current process ID in the file names to prevent conflicts
- # with invocations for multiple testsuites.
- set src [standard_temp_file vmx[pid].c]
- set exe [standard_temp_file vmx[pid].x]
-
- gdb_produce_source $src {
+ # Compile a test program containing VMX instructions.
+ set src {
int main() {
#ifdef __MACH__
asm volatile ("vor v0,v0,v0");
return 0;
}
}
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $exe executable $compile_flags]
- file delete $src
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 1" 2
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
return 1
}
- # No error message, compilation succeeded so now run it via gdb.
+ # Compilation succeeded so now run it via gdb.
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
- gdb_load "$exe"
+ gdb_load "$obj"
gdb_run_cmd
gdb_expect {
-re ".*Illegal instruction.*${gdb_prompt} $" {
}
}
gdb_exit
- remote_file build delete $exe
+ remote_file build delete $obj
verbose "$me: returning $skip_vmx_tests" 2
return $skip_vmx_tests
}
# Make sure we have a compiler that understands altivec.
- set compile_flags {debug nowarnings quiet}
if [get_compiler_info] {
warning "Could not get compiler info"
return 1
}
if [test_compiler_info gcc*] {
- set compile_flags "$compile_flags additional_flags=-mvsx"
+ set compile_flags "additional_flags=-mvsx"
} elseif [test_compiler_info xlc*] {
- set compile_flags "$compile_flags additional_flags=-qasm=gcc"
+ set compile_flags "additional_flags=-qasm=gcc"
} else {
verbose "Could not compile with vsx support, returning 1" 2
return 1
}
- set src [standard_temp_file vsx[pid].c]
- set exe [standard_temp_file vsx[pid].x]
-
- gdb_produce_source $src {
+ # Compile a test program containing VSX instructions.
+ set src {
int main() {
double a[2] = { 1.0, 2.0 };
#ifdef __MACH__
return 0;
}
}
-
- verbose "$me: compiling testfile $src" 2
- set lines [gdb_compile $src $exe executable $compile_flags]
- file delete $src
-
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 1" 2
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
return 1
}
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
- gdb_load "$exe"
+ gdb_load "$obj"
gdb_run_cmd
gdb_expect {
-re ".*Illegal instruction.*${gdb_prompt} $" {
}
}
gdb_exit
- remote_file build delete $exe
+ remote_file build delete $obj
verbose "$me: returning $skip_vsx_tests" 2
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"
+
+ # Compile a test program.
+ set src {
+ int main() {
+ asm volatile ("xbegin .L0");
+ asm volatile ("xend");
+ asm volatile (".L0: nop");
+ 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: 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 $obj
+
+ 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 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]
+ # Compile a test program.
+ set src { int main() { return 0; } }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 0
+ }
- gdb_produce_source $src {
- int main(void) { return 0; }
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load $obj
+ if ![runto_main] {
+ return 1
+ }
+ # In case of an unexpected output, we return 2 as a fail value.
+ set skip_btrace_tests 2
+ gdb_test_multiple "record btrace" "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\r\n$gdb_prompt $" {
+ set skip_btrace_tests 0
+ }
}
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_btrace_tests" 2
+ return $skip_btrace_tests
+}
- verbose "$me: compiling testfile $src" 2
- set compile_flags {debug nowarnings quiet}
- set lines [gdb_compile $src $exe executable $compile_flags]
+# 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.
- if ![string match "" $lines] then {
- verbose "$me: testfile compilation failed, returning 1" 2
- file delete $src
+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
}
+ # Compile a test program.
+ set src { int main() { return 0; } }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 0
+ }
+
# No error message, compilation succeeded so now run it via gdb.
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
- gdb_load $exe
+ gdb_load $obj
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" "check btrace support" {
+ gdb_test_multiple "record btrace pt" "check btrace pt support" {
-re "You can't do that when your target is.*\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\r\n$gdb_prompt $" {
+ -re "support was disabled at compile time.*\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
+ remote_file build delete $obj
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.
+# Run a test on the target to see if it supports Aarch64 SVE hardware.
+# Return 0 if so, 1 if it does not. Note this causes a restart of GDB.
+
+gdb_caching_proc skip_aarch64_sve_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_aarch64_sve_tests"
+
+ if { ![is_aarch64_target]} {
+ return 1
+ }
+
+ set compile_flags "{additional_flags=-march=armv8-a+sve}"
+
+ # Compile a test program containing SVE instructions.
+ set src {
+ int main() {
+ asm volatile ("ptrue p0.b");
+ return 0;
+ }
+ }
+ if {![gdb_simple_compile $me $src executable $compile_flags]} {
+ return 1
+ }
+
+ # Compilation succeeded so now run it via gdb.
+ clean_restart $obj
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "\n$me sve hardware not detected"
+ set skip_sve_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "\n$me: sve hardware detected"
+ set skip_sve_tests 0
+ }
+ default {
+ warning "\n$me: default case taken"
+ set skip_sve_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $obj
+
+ verbose "$me: returning $skip_sve_tests" 2
+ return $skip_sve_tests
+}
+
+
+# A helper that compiles a test case to see if __int128 is supported.
+proc gdb_int128_helper {lang} {
+ return [gdb_can_simple_compile "i128-for-$lang" {
+ __int128 x;
+ int main() { return 0; }
+ } executable $lang]
+}
+
+# Return true if the C compiler understands the __int128 type.
+gdb_caching_proc has_int128_c {
+ return [gdb_int128_helper c]
+}
-proc skip_hp_tests {} {
- eval set skip_hp [ expr ![isnative] || ![istarget "hppa*-*-hpux*"] ]
- verbose "Skip hp tests is $skip_hp"
- return $skip_hp
+# Return true if the C++ compiler understands the __int128 type.
+gdb_caching_proc has_int128_cxx {
+ return [gdb_int128_helper c++]
+}
+
+# Return true if the IFUNC feature is unsupported.
+gdb_caching_proc skip_ifunc_tests {
+ if [gdb_can_simple_compile ifunc {
+ extern void f_ ();
+ typedef void F (void);
+ F* g (void) { return &f_; }
+ void f () __attribute__ ((ifunc ("g")));
+ } object] {
+ return 0
+ } else {
+ return 1
+ }
}
# Return whether we should skip tests for showing inlined functions in
|| [istarget "x86_64-*-*"]
|| [istarget "ia64-*-*"]
|| [istarget "arm*-*-*"]
- || [istarget "aarch64*-*-*"]} {
+ || [istarget "aarch64*-*-*"]
+ || [istarget "s390*-*-*"] } {
return 0
}
return $result
}
-# Check whether we're testing with the remote or extended-remote
-# targets.
-
-proc gdb_is_target_remote {} {
- global gdb_prompt
+# Helper for gdb_is_target_* procs. TARGET_NAME is the name of the target
+# we're looking for (used to build the test name). TARGET_STACK_REGEXP
+# is a regexp that will match the output of "maint print target-stack" if
+# the target in question is currently pushed. PROMPT_REGEXP is a regexp
+# matching the expected prompt after the command output.
- set test "probe for target remote"
+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 ".*emote serial target in gdb-specific protocol.*$gdb_prompt $" {
+ -re "${target_stack_regexp}${prompt_regexp}" {
pass $test
return 1
}
- -re "$gdb_prompt $" {
+ -re "$prompt_regexp" {
pass $test
}
}
return 0
}
+# Helper for gdb_is_target_remote where the expected prompt is variable.
+
+proc gdb_is_target_remote_prompt { prompt_regexp } {
+ return [gdb_is_target_1 "remote" ".*emote serial target in gdb-specific protocol.*" $prompt_regexp]
+}
+
+# Check whether we're testing with the remote or extended-remote
+# targets.
+
+proc gdb_is_target_remote { } {
+ global gdb_prompt
+
+ return [gdb_is_target_remote_prompt "$gdb_prompt $"]
+}
+
+# Check whether we're testing with the native target.
+
+proc gdb_is_target_native { } {
+ global gdb_prompt
+
+ return [gdb_is_target_1 "native" ".*native \\(Native process\\).*" "$gdb_prompt $"]
+}
+
+# Return the effective value of use_gdb_stub.
+#
+# If the use_gdb_stub global has been set (it is set when the gdb process is
+# spawned), return that. Otherwise, return the value of the use_gdb_stub
+# property from the board file.
+#
+# This is the preferred way of checking use_gdb_stub, since it allows to check
+# the value before the gdb has been spawned and it will return the correct value
+# even when it was overriden by the test.
+
+proc use_gdb_stub {} {
+ global use_gdb_stub
+
+ if [info exists use_gdb_stub] {
+ return $use_gdb_stub
+ }
+
+ return [target_info exists use_gdb_stub]
+}
+
# Return 1 if the current remote target is an instance of our GDBserver, 0
# otherwise. Return -1 if there was an error and we can't tell.
global gdb_prompt
set is_gdbserver -1
- set test "Probing for GDBserver"
+ set test "probing for GDBserver"
gdb_test_multiple "monitor help" $test {
-re "The following monitor commands are supported.*Quit GDBserver.*$gdb_prompt $" {
return $is_gdbserver
}
-set compiler_info "unknown"
+# N.B. compiler_info is intended to be local to this file.
+# Call test_compiler_info with no arguments to fetch its value.
+# Yes, this is counterintuitive when there's get_compiler_info,
+# but that's the current API.
+if [info exists compiler_info] {
+ unset compiler_info
+}
+
set gcc_compiled 0
-set hp_cc_compiler 0
-set hp_aCC_compiler 0
# Figure out what compiler I am using.
+# The result is cached so only the first invocation runs the compiler.
#
# ARG can be empty or "C++". If empty, "C" is assumed.
#
# Legacy global data symbols.
global gcc_compiled
- global hp_cc_compiler
- global hp_aCC_compiler
+
+ if [info exists compiler_info] {
+ # Already computed.
+ return 0
+ }
# Choose which file to preprocess.
set ifile "${srcdir}/lib/compiler.c"
# We have to use -E and -o together, despite the comments
# above, because of how DejaGnu handles remote host testing.
set ppout "$outdir/compiler.i"
- gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet]
+ gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet getting_compiler_info]
set file [open $ppout r]
set cppout [read $file]
close $file
} else {
- set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ]
+ set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet getting_compiler_info] ]
}
eval log_file $saved_log
}
}
- # Reset to unknown compiler if any diagnostics happened.
+ # Set to unknown if for some reason compiler_info didn't get defined.
+ if ![info exists compiler_info] {
+ verbose -log "get_compiler_info: compiler_info not provided"
+ set compiler_info "unknown"
+ }
+ # Also set to unknown compiler if any diagnostics happened.
if { $unknown } {
+ verbose -log "get_compiler_info: got unexpected diagnostics"
set compiler_info "unknown"
}
# Set the legacy symbols.
- set gcc_compiled 0
- set hp_cc_compiler 0
- set hp_aCC_compiler 0
- if { [regexp "^gcc-1-" "$compiler_info" ] } { set gcc_compiled 1 }
- if { [regexp "^gcc-2-" "$compiler_info" ] } { set gcc_compiled 2 }
- if { [regexp "^gcc-3-" "$compiler_info" ] } { set gcc_compiled 3 }
- if { [regexp "^gcc-4-" "$compiler_info" ] } { set gcc_compiled 4 }
- if { [regexp "^gcc-5-" "$compiler_info" ] } { set gcc_compiled 5 }
- if { [regexp "^hpcc-" "$compiler_info" ] } { set hp_cc_compiler 1 }
- if { [regexp "^hpacc-" "$compiler_info" ] } { set hp_aCC_compiler 1 }
+ set gcc_compiled 0
+ regexp "^gcc-(\[0-9\]+)-" "$compiler_info" matchall gcc_compiled
# Log what happened.
verbose -log "get_compiler_info: $compiler_info"
uplevel \#0 { set true 1 }
uplevel \#0 { set false 0 }
- # Use of aCC results in boolean results being displayed as
- # "true" or "false"
- if { $hp_aCC_compiler } {
- uplevel \#0 { set true true }
- uplevel \#0 { set false false }
- }
-
return 0
}
+# Return the compiler_info string if no arg is provided.
+# Otherwise the argument is a glob-style expression to match against
+# compiler_info.
+
proc test_compiler_info { {compiler ""} } {
global compiler_info
+ get_compiler_info
- # if no arg, return the compiler_info string
-
- if [string match "" $compiler] {
- if [info exists compiler_info] {
- return $compiler_info
- } else {
- perror "No compiler info found."
- }
- }
+ # If no arg, return the compiler_info string.
+ if [string match "" $compiler] {
+ return $compiler_info
+ }
return [string match $compiler $compiler_info]
}
set gdb_wrapper_target [current_target_name]
}
+# Determine options that we always want to pass to the compiler.
+gdb_caching_proc universal_compile_options {
+ set me "universal_compile_options"
+ set options {}
+
+ set src [standard_temp_file ccopts[pid].c]
+ set obj [standard_temp_file ccopts[pid].o]
+
+ gdb_produce_source $src {
+ int foo(void) { return 0; }
+ }
+
+ # Try an option for disabling colored diagnostics. Some compilers
+ # yield colored diagnostics by default (when run from a tty) unless
+ # such an option is specified.
+ set opt "additional_flags=-fdiagnostics-color=never"
+ set lines [target_compile $src $obj object [list "quiet" $opt]]
+ if [string match "" $lines] then {
+ # Seems to have worked; use the option.
+ lappend options $opt
+ }
+ file delete $src
+ file delete $obj
+
+ verbose "$me: returning $options" 2
+ return $options
+}
+
+# Compile the code in $code to a file based on $name, using the flags
+# $compile_flag as well as debug, nowarning and quiet.
+# Return 1 if code can be compiled
+# Leave the file name of the resulting object in the upvar object.
+
+proc gdb_simple_compile {name code {type object} {compile_flags {}} {object obj}} {
+ upvar $object obj
+
+ switch -regexp -- $type {
+ "executable" {
+ set postfix "x"
+ }
+ "object" {
+ set postfix "o"
+ }
+ "preprocess" {
+ set postfix "i"
+ }
+ "assembly" {
+ set postfix "s"
+ }
+ }
+ set src [standard_temp_file $name-[pid].c]
+ set obj [standard_temp_file $name-[pid].$postfix]
+ set compile_flags [concat $compile_flags {debug nowarnings quiet}]
+
+ gdb_produce_source $src $code
+
+ verbose "$name: compiling testfile $src" 2
+ set lines [gdb_compile $src $obj $type $compile_flags]
+
+ file delete $src
+
+ if ![string match "" $lines] then {
+ verbose "$name: compilation failed, returning 0" 2
+ return 0
+ }
+ return 1
+}
+
+# Compile the code in $code to a file based on $name, using the flags
+# $compile_flag as well as debug, nowarning and quiet.
+# Return 1 if code can be compiled
+# Delete all created files and objects.
+
+proc gdb_can_simple_compile {name code {type object} {compile_flags ""}} {
+ set ret [gdb_simple_compile $name $code $type $compile_flags temp_obj]
+ file delete $temp_obj
+ return $ret
+}
+
# Some targets need to always link a special object in. Save its path here.
global gdb_saved_set_unbuffered_mode_obj
set gdb_saved_set_unbuffered_mode_obj ""
+# Compile source files specified by SOURCE into a binary of type TYPE at path
+# DEST. gdb_compile is implemented using DejaGnu's target_compile, so the type
+# parameter and most options are passed directly to it.
+#
+# The type can be one of the following:
+#
+# - object: Compile into an object file.
+# - executable: Compile and link into an executable.
+# - preprocess: Preprocess the source files.
+# - assembly: Generate assembly listing.
+#
+# The following options are understood and processed by gdb_compile:
+#
+# - shlib=so_path: Add SO_PATH to the sources, and enable some target-specific
+# quirks to be able to use shared libraries.
+# - shlib_load: Link with appropriate libraries to allow the test to
+# dynamically load libraries at runtime. For example, on Linux, this adds
+# -ldl so that the test can use dlopen.
+# - nowarnings: Inhibit all compiler warnings.
+# - pie: Force creation of PIE executables.
+# - nopie: Prevent creation of PIE executables.
+#
+# And here are some of the not too obscure options understood by DejaGnu that
+# influence the compilation:
+#
+# - additional_flags=flag: Add FLAG to the compiler flags.
+# - libs=library: Add LIBRARY to the libraries passed to the linker. The
+# argument can be a file, in which case it's added to the sources, or a
+# linker flag.
+# - 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.
+# - debug: Build with debug information.
+# - optimize: Build with optimization.
+
proc gdb_compile {source dest type options} {
global GDB_TESTCASE_OPTIONS
global gdb_wrapper_file
# Add platform-specific options if a shared library was specified using
# "shlib=librarypath" in OPTIONS.
- set new_options ""
+ set new_options {}
+ if {[lsearch -exact $options rust] != -1} {
+ # -fdiagnostics-color is not a rustcc option.
+ } else {
+ set new_options [universal_compile_options]
+ }
set shlib_found 0
set shlib_load 0
+ set getting_compiler_info 0
foreach opt $options {
- if [regexp {^shlib=(.*)} $opt dummy_var shlib_name] {
+ if {[regexp {^shlib=(.*)} $opt dummy_var shlib_name]
+ && $type == "executable"} {
if [test_compiler_info "xlc-*"] {
# IBM xlc compiler doesn't accept shared library named other
# than .so: use "-Wl," to bypass this
|| [istarget *-*-cygwin*]) } {
lappend new_options "additional_flags=-Wl,--enable-auto-import"
}
+ if { [test_compiler_info "gcc-*"] || [test_compiler_info "clang-*"] } {
+ # Undo debian's change in the default.
+ # Put it at the front to not override any user-provided
+ # value, and to make sure it appears in front of all the
+ # shlibs!
+ lappend new_options "early_flags=-Wl,--no-as-needed"
+ }
}
- } elseif { $opt == "shlib_load" } {
+ } elseif { $opt == "shlib_load" && $type == "executable" } {
set shlib_load 1
+ } elseif { $opt == "getting_compiler_info" } {
+ # If this is set, calling test_compiler_info will cause recursion.
+ set getting_compiler_info 1
} else {
lappend new_options $opt
}
}
- # We typically link to shared libraries using an absolute path, and
- # that's how they are found at runtime. If we are going to
- # dynamically load one by basename, we must specify rpath. If we
- # are using a remote host, DejaGNU will link to the shared library
- # using a relative path, so again we must specify an rpath.
- if { $shlib_load || ($shlib_found && [is_remote target]) } {
+ # Ensure stack protector is disabled for GCC, as this causes problems with
+ # DWARF line numbering.
+ # See https://gcc.gnu.org/bugzilla/show_bug.cgi?id=88432
+ # This option defaults to on for Debian/Ubuntu.
+ if { $getting_compiler_info == 0
+ && [test_compiler_info {gcc-*-*}]
+ && !([test_compiler_info {gcc-[0-3]-*}]
+ || [test_compiler_info {gcc-4-0-*}]) } {
+ # Put it at the front to not override any user-provided value.
+ lappend new_options "early_flags=-fno-stack-protector"
+ }
+
+ # Because we link with libraries using their basename, we may need
+ # (depending on the platform) to set a special rpath value, to allow
+ # the executable to find the libraries it depends on.
+ if { $shlib_load || $shlib_found } {
if { ([istarget "*-*-mingw*"]
|| [istarget *-*-cygwin*]
- || [istarget *-*-pe*]
- || [istarget hppa*-*-hpux*])} {
+ || [istarget *-*-pe*]) } {
# Do not need anything.
} elseif { [istarget *-*-freebsd*] || [istarget *-*-openbsd*] } {
lappend new_options "ldflags=-Wl,-rpath,${outdir}"
if [target_info exists gdb,nowarnings_flag] {
set flag "additional_flags=[target_info gdb,nowarnings_flag]"
} else {
- set flag "additional_flags=-w"
+ set flag "additional_flags=-w"
+ }
+ set options [lreplace $options $nowarnings $nowarnings $flag]
+ }
+
+ # Replace the "pie" option with the appropriate compiler and linker flags
+ # to enable PIE executables.
+ set pie [lsearch -exact $options pie]
+ if {$pie != -1} {
+ 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
+ # and SPARC, fpie can cause compile errors due to the GOT exceeding
+ # a maximum size. On other architectures the two flags are
+ # identical (see the GCC manual). Note Debian9 and Ubuntu16.10
+ # onwards default GCC to using fPIE. If you do require fpie, then
+ # it can be set using the pie_flag.
+ set flag "additional_flags=-fPIE"
+ }
+ set options [lreplace $options $pie $pie $flag]
+
+ if [target_info exists gdb,pie_ldflag] {
+ set flag "ldflags=[target_info gdb,pie_ldflag]"
+ } else {
+ set flag "ldflags=-pie"
+ }
+ lappend options "$flag"
+ }
+
+ # Replace the "nopie" option with the appropriate linker flag to disable
+ # PIE executables. There are no compiler flags for this option.
+ set nopie [lsearch -exact $options nopie]
+ if {$nopie != -1} {
+ if [target_info exists gdb,nopie_flag] {
+ set flag "ldflags=[target_info gdb,nopie_flag]"
+ } else {
+ set flag "ldflags=-no-pie"
}
- set options [lreplace $options $nowarnings $nowarnings $flag]
+ set options [lreplace $options $nopie $nopie $flag]
}
if { $type == "executable" } {
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+ unsupported "couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
lappend obj_options "additional_flags=-fpic"
}
}
+ "icc-*" {
+ lappend obj_options "additional_flags=-fpic"
+ }
default {
- switch -glob [istarget] {
- "hppa*-hp-hpux*" {
- lappend obj_options "additional_flags=+z"
- }
- default {
- # don't know what the compiler is...
- }
- }
+ # don't know what the compiler is...
}
}
lappend objects ${outdir}/${sourcebase}.o
}
- if [istarget "hppa*-*-hpux*"] {
- remote_exec build "ld -b ${objects} -o ${dest}"
+ set link_options $options
+ if [test_compiler_info "xlc-*"] {
+ lappend link_options "additional_flags=-qmkshrobj"
} else {
- set link_options $options
- if [test_compiler_info "xlc-*"] {
- lappend link_options "additional_flags=-qmkshrobj"
- } else {
- lappend link_options "additional_flags=-shared"
-
- if { ([istarget "*-*-mingw*"]
- || [istarget *-*-cygwin*]
- || [istarget *-*-pe*]) } {
- if { [is_remote host] } {
- set name [file tail ${dest}]
- } else {
- set name ${dest}
- }
- lappend link_options "additional_flags=-Wl,--out-implib,${name}.a"
- } elseif [is_remote target] {
- # By default, we do not set the soname. This causes the linker
- # on ELF systems to create a DT_NEEDED entry in the executable
- # refering to the full path name of the library. This is a
- # problem in remote testing if the library is in a different
- # directory there. To fix this, we set a soname of just the
- # base filename for the library, and add an appropriate -rpath
- # to the main executable (in gdb_compile).
- set destbase [file tail $dest]
- lappend link_options "additional_flags=-Wl,-soname,$destbase"
- }
- }
- if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} {
- return -1
- }
- if { [is_remote host]
- && ([istarget "*-*-mingw*"]
- || [istarget *-*-cygwin*]
- || [istarget *-*-pe*]) } {
- set dest_tail_name [file tail ${dest}]
- remote_upload host $dest_tail_name.a ${dest}.a
- remote_file host delete $dest_tail_name.a
+ lappend link_options "additional_flags=-shared"
+
+ if { ([istarget "*-*-mingw*"]
+ || [istarget *-*-cygwin*]
+ || [istarget *-*-pe*]) } {
+ if { [is_remote host] } {
+ set name [file tail ${dest}]
+ } else {
+ set name ${dest}
+ }
+ lappend link_options "additional_flags=-Wl,--out-implib,${name}.a"
+ } else {
+ # Set the soname of the library. This causes the linker on ELF
+ # systems to create the DT_NEEDED entry in the executable referring
+ # to the soname of the library, and not its absolute path. This
+ # (using the absolute path) would be problem when testing on a
+ # remote target.
+ #
+ # In conjunction with setting the soname, we add the special
+ # rpath=$ORIGIN value when building the executable, so that it's
+ # able to find the library in its own directory.
+ set destbase [file tail $dest]
+ lappend link_options "additional_flags=-Wl,-soname,$destbase"
}
}
- return ""
+ if {[gdb_compile "${objects}" "${dest}" executable $link_options] != ""} {
+ return -1
+ }
+ if { [is_remote host]
+ && ([istarget "*-*-mingw*"]
+ || [istarget *-*-cygwin*]
+ || [istarget *-*-pe*]) } {
+ set dest_tail_name [file tail ${dest}]
+ remote_upload host $dest_tail_name.a ${dest}.a
+ remote_file host delete $dest_tail_name.a
+ }
+
+ return ""
}
# This is just like gdb_compile_shlib, above, except that it tries compiling
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile $sources: ${why_msg}"
+ unsupported "couldn't compile $sources: ${why_msg}"
return -1
}
}
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile [file tail $source]: ${why_msg}"
+ unsupported "couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
# 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
}
#
}
}
-# Like remote_download but provides a gdb-specific behavior. If DEST
-# is "host", and the host is not remote, and TOFILE is not specified,
-# then the [file tail] of FROMFILE is passed through
-# standard_output_file to compute the destination.
+# Like remote_download but provides a gdb-specific behavior.
+#
+# If the destination board is remote, the local file FROMFILE is transferred as
+# usual with remote_download to TOFILE on the remote board. The destination
+# filename is added to the CLEANFILES global, so it can be cleaned up at the
+# end of the test.
+#
+# If the destination board is local, the destination path TOFILE is passed
+# through standard_output_file, and FROMFILE is copied there.
+#
+# In both cases, if TOFILE is omitted, it defaults to the [file tail] of
+# FROMFILE.
proc gdb_remote_download {dest fromfile {tofile {}}} {
- if {$dest == "host" && ![is_remote host] && $tofile == ""} {
- set tofile [standard_output_file [file tail $fromfile]]
+ # If TOFILE is not given, default to the same filename as FROMFILE.
+ if {[string length $tofile] == 0} {
+ set tofile [file tail $fromfile]
}
- if { $tofile == "" } {
- return [remote_download $dest $fromfile]
+ if {[is_remote $dest]} {
+ # When the DEST is remote, we simply send the file to DEST.
+ global cleanfiles
+
+ set destname [remote_download $dest $fromfile $tofile]
+ lappend cleanfiles $destname
+
+ return $destname
} else {
- return [remote_download $dest $fromfile $tofile]
- }
-}
+ # When the DEST is local, we copy the file to the test directory (where
+ # the executable is).
+ #
+ # Note that we pass TOFILE through standard_output_file, regardless of
+ # whether it is absolute or relative, because we don't want the tests
+ # to be able to write outside their standard output directory.
-# gdb_download
-#
-# Copy a file to the remote target and return its target filename.
-# Schedule the file to be deleted at the end of this test.
+ set tofile [standard_output_file $tofile]
-proc gdb_download { filename } {
- global cleanfiles
+ file copy -force $fromfile $tofile
- set destname [remote_download target $filename]
- lappend cleanfiles $destname
- return $destname
+ return $tofile
+ }
}
-# gdb_load_shlibs LIB...
+# gdb_load_shlib LIB...
#
-# Copy the listed libraries to the target.
+# Copy the listed library to the target.
-proc gdb_load_shlibs { args } {
- if {![is_remote target]} {
- return
+proc gdb_load_shlib { file } {
+ global gdb_spawn_id
+
+ if ![info exists gdb_spawn_id] {
+ perror "gdb_load_shlib: GDB is not running"
}
- foreach file $args {
- gdb_download [shlib_target_file $file]
+ set dest [gdb_remote_download target [shlib_target_file $file]]
+
+ if {[is_remote target]} {
+ # If the target is remote, we need to tell gdb where to find the
+ # libraries.
+ #
+ # We could set this even when not testing remotely, but a user
+ # generally won't set it unless necessary. In order to make the tests
+ # more like the real-life scenarios, we don't set it for local testing.
+ gdb_test "set solib-search-path [file dirname $file]" "" ""
}
- # Even if the target supplies full paths for shared libraries,
- # they may not be paths for this system.
- gdb_test "set solib-search-path [file dirname [lindex $args 0]]" "" ""
+ return $dest
}
#
}
}
+# 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 { [info exists GDB_PARALLEL] && $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.
proc standard_output_file {basename} {
- global objdir subdir gdb_test_file_name GDB_PARALLEL
+ global objdir subdir gdb_test_file_name
- if {[info exists GDB_PARALLEL]} {
- set dir [file join $objdir outputs $subdir $gdb_test_file_name]
- file mkdir $dir
- return [file join $dir $basename]
- } else {
- return [file join $objdir $subdir $basename]
- }
+ set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name]
+ file mkdir $dir
+ return [file join $dir $basename]
}
# Return the name of a file in our standard temporary directory.
proc standard_temp_file {basename} {
- global objdir GDB_PARALLEL
-
- if {[info exists GDB_PARALLEL]} {
- return [file join $objdir temp $basename]
- } else {
- return $basename
- }
+ # Since a particular runtest invocation is only executing a single test
+ # file at any given time, we can use the runtest pid to build the
+ # path of the temp directory.
+ set dir [make_gdb_parallel_path temp [pid]]
+ file mkdir $dir
+ return [file join $dir $basename]
}
# Set 'testfile', 'srcfile', and 'binfile'.
# read from this file.
setenv INPUTRC "/dev/null"
- # The gdb.base/readline.exp arrow key test relies on the standard VT100
- # bindings, so make sure that an appropriate terminal is selected.
- # The same bug doesn't show up if we use ^P / ^N instead.
- setenv TERM "vt100"
+ # 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,
}
}
-# Print a message and return true if a test should be skipped
-# due to lack of floating point suport.
+# Return true if a test should be skipped due to lack of floating
+# point support or GDB can't fetch the contents from floating point
+# registers.
-proc gdb_skip_float_test { msg } {
+gdb_caching_proc gdb_skip_float_test {
if [target_info exists gdb,skip_float_tests] {
- verbose "Skipping test '$msg': no float tests."
return 1
}
+
+ # There is an ARM kernel ptrace bug that hardware VFP registers
+ # are not updated after GDB ptrace set VFP registers. The bug
+ # was introduced by kernel commit 8130b9d7b9d858aa04ce67805e8951e3cb6e9b2f
+ # in 2012 and is fixed in e2dfb4b880146bfd4b6aa8e138c0205407cebbaf
+ # in May 2016. In other words, kernels older than 4.6.3, 4.4.14,
+ # 4.1.27, 3.18.36, and 3.14.73 have this bug.
+ # This kernel bug is detected by check how does GDB change the
+ # program result by changing one VFP register.
+ if { [istarget "arm*-*-linux*"] } {
+
+ set compile_flags {debug nowarnings }
+
+ # Set up, compile, and execute a test program having VFP
+ # operations.
+ set src [standard_temp_file arm_vfp[pid].c]
+ set exe [standard_temp_file arm_vfp[pid].x]
+
+ gdb_produce_source $src {
+ int main() {
+ double d = 4.0;
+ int ret;
+
+ asm ("vldr d0, [%0]" : : "r" (&d));
+ asm ("vldr d1, [%0]" : : "r" (&d));
+ asm (".global break_here\n"
+ "break_here:");
+ asm ("vcmp.f64 d0, d1\n"
+ "vmrs APSR_nzcv, fpscr\n"
+ "bne L_value_different\n"
+ "movs %0, #0\n"
+ "b L_end\n"
+ "L_value_different:\n"
+ "movs %0, #1\n"
+ "L_end:\n" : "=r" (ret) :);
+
+ /* Return $d0 != $d1. */
+ return ret;
+ }
+ }
+
+ verbose "compiling testfile $src" 2
+ set lines [gdb_compile $src $exe executable $compile_flags]
+ file delete $src
+
+ if ![string match "" $lines] then {
+ verbose "testfile compilation failed, returning 1" 2
+ return 0
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+ # Run the test up to 5 times to detect whether ptrace can
+ # correctly update VFP registers or not.
+ set skip_vfp_test 0
+ for {set i 0} {$i < 5} {incr i} {
+ global gdb_prompt srcdir subdir
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$exe"
+
+ runto_main
+ gdb_test "break *break_here"
+ gdb_continue_to_breakpoint "break_here"
+
+ # Modify $d0 to a different value, so the exit code should
+ # be 1.
+ gdb_test "set \$d0 = 5.0"
+
+ set test "continue to exit"
+ gdb_test_multiple "continue" "$test" {
+ -re "exited with code 01.*$gdb_prompt $" {
+ }
+ -re "exited normally.*$gdb_prompt $" {
+ # However, the exit code is 0. That means something
+ # wrong in setting VFP registers.
+ set skip_vfp_test 1
+ break
+ }
+ }
+ }
+
+ gdb_exit
+ remote_file build delete $exe
+
+ return $skip_vfp_test
+ }
return 0
}
# NOTE: This must be called while gdb is *not* running.
gdb_caching_proc gdb_skip_xml_test {
+ global gdb_spawn_id
global gdb_prompt
global srcdir
+ if { [info exists gdb_spawn_id] } {
+ error "GDB must not be running in gdb_skip_xml_tests."
+ }
+
set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"]
gdb_start
gdb_caching_proc gdb_has_argv0 {
set result 0
- # Set up, compile, and execute a test program to check whether
- # argv[0] is available.
- set src [standard_temp_file has_argv0[pid].c]
- set exe [standard_temp_file has_argv0[pid].x]
-
- gdb_produce_source $src {
+ # Compile and execute a test program to check whether argv[0] is available.
+ gdb_simple_compile has_argv0 {
int main (int argc, char **argv) {
return 0;
}
- }
+ } executable
- gdb_compile $src $exe executable {debug}
# Helper proc.
proc gdb_has_argv0_1 { exe } {
}
}
+ set old_elements "200"
+ set test "show print elements"
+ gdb_test_multiple $test $test {
+ -re "Limit on string chars or array elements to print is (\[^\r\n\]+)\\.\r\n$gdb_prompt $" {
+ set old_elements $expect_out(1,string)
+ }
+ }
+ set old_repeats "200"
+ set test "show print repeats"
+ gdb_test_multiple $test $test {
+ -re "Threshold for repeated print elements is (\[^\r\n\]+)\\.\r\n$gdb_prompt $" {
+ set old_repeats $expect_out(1,string)
+ }
+ }
+ gdb_test_no_output "set print elements unlimited" ""
+ gdb_test_no_output "set print repeats unlimited" ""
+
+ set retval 0
# Check whether argc is 1.
gdb_test_multiple "p argc" "p argc" {
-re " = 1\r\n${gdb_prompt} $" {
gdb_test_multiple "p argv\[0\]" "p argv\[0\]" {
-re " = $hex \".*[file tail $exe]\"\r\n${gdb_prompt} $" {
- return 1
+ set retval 1
}
-re "${gdb_prompt} $" {
- return 0
}
}
}
-re "${gdb_prompt} $" {
- return 0
}
}
- return 0
+
+ gdb_test_no_output "set print elements $old_elements" ""
+ gdb_test_no_output "set print repeats $old_repeats" ""
+
+ return $retval
}
- set result [gdb_has_argv0_1 $exe]
+ set result [gdb_has_argv0_1 $obj]
gdb_exit
- file delete $src
- file delete $exe
+ file delete $obj
if { !$result
&& ([istarget *-*-linux*]
|| [istarget *-wince-pe] || [istarget *-*-mingw32ce*]
|| [istarget *-*-symbianelf*]
|| [istarget *-*-osf*]
- || [istarget *-*-hpux*]
|| [istarget *-*-dicos*]
|| [istarget *-*-nto*]
|| [istarget *-*-*vms*]
}
}
set ret [$func $sources_path "${binfile}" $options]
+ } elseif {[lsearch -exact $options rust] != -1} {
+ set sources_path {}
+ foreach {s local_options} $args {
+ if { [regexp "^/" "$s"] } then {
+ lappend sources_path "$s"
+ } else {
+ lappend sources_path "$srcdir/$subdir/$s"
+ }
+ }
+ set ret [gdb_compile_rust $sources_path "${binfile}" $options]
} else {
set objects {}
set i 0
return [eval build_executable_from_specs $arglist]
}
-# Starts fresh GDB binary and loads EXECUTABLE into GDB. EXECUTABLE is
-# the basename of the binary.
-# The return value is 0 for success, -1 for failure.
-proc clean_restart { executable } {
+# Starts fresh GDB binary and loads an optional executable into GDB.
+# Usage: clean_restart [executable]
+# EXECUTABLE is the basename of the binary.
+
+proc clean_restart { args } {
global srcdir
global subdir
- set binfile [standard_output_file ${executable}]
+
+ if { [llength $args] > 1 } {
+ error "bad number of args: [llength $args]"
+ }
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
- return [gdb_load ${binfile}]
+
+ if { [llength $args] >= 1 } {
+ set executable [lindex $args 0]
+ set binfile [standard_output_file ${executable}]
+ gdb_load ${binfile}
+ }
}
# Prepares for testing by calling build_executable_full, then
return 0
}
-proc get_valueof { fmt exp default } {
+# Retrieve the value of EXP in the inferior, represented in format
+# specified in FMT (using "printFMT"). 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_valueof { fmt exp default {test ""} } {
global gdb_prompt
- set test "get valueof \"${exp}\""
+ if {$test == "" } {
+ set test "get valueof \"${exp}\""
+ }
+
set val ${default}
gdb_test_multiple "print${fmt} ${exp}" "$test" {
- -re "\\$\[0-9\]* = (.*)\[\r\n\]*$gdb_prompt $" {
+ -re "\\$\[0-9\]* = (\[^\r\n\]*)\[\r\n\]*$gdb_prompt $" {
set val $expect_out(1,string)
- pass "$test ($val)"
+ pass "$test"
}
timeout {
fail "$test (timeout)"
return ${val}
}
-proc get_integer_valueof { exp default } {
+# 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
+# a test message is built from EXP.
+
+proc get_integer_valueof { exp default {test ""} } {
global gdb_prompt
- set test "get integer valueof \"${exp}\""
+ if {$test == ""} {
+ set test "get integer valueof \"${exp}\""
+ }
+
set val ${default}
gdb_test_multiple "print /d ${exp}" "$test" {
-re "\\$\[0-9\]* = (\[-\]*\[0-9\]*).*$gdb_prompt $" {
set val $expect_out(1,string)
- pass "$test ($val)"
+ pass "$test"
}
timeout {
fail "$test (timeout)"
return ${val}
}
-proc get_hexadecimal_valueof { exp default } {
+# Retrieve the value of EXP in the inferior, as an hexadecimal value
+# (using "print /x"). 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_hexadecimal_valueof { exp default {test ""} } {
global gdb_prompt
- send_gdb "print /x ${exp}\n"
- set test "get hexadecimal valueof \"${exp}\""
- gdb_expect {
+
+ if {$test == ""} {
+ set test "get hexadecimal valueof \"${exp}\""
+ }
+
+ set val ${default}
+ gdb_test_multiple "print /x ${exp}" $test {
-re "\\$\[0-9\]* = (0x\[0-9a-zA-Z\]+).*$gdb_prompt $" {
set val $expect_out(1,string)
pass "$test"
}
- timeout {
- set val ${default}
- fail "$test (timeout)"
- }
}
return ${val}
}
-proc get_sizeof { type default } {
- return [get_integer_valueof "sizeof (${type})" $default]
+# Retrieve the size of TYPE in the inferior, as a decimal value. 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 'sizeof (TYPE)'.
+
+proc get_sizeof { type default {test ""} } {
+ return [get_integer_valueof "sizeof (${type})" $default $test]
}
proc get_target_charset { } {
return "UTF-8"
}
+# Get the address of VAR.
+
+proc get_var_address { var } {
+ global gdb_prompt hex
+
+ # Match output like:
+ # $1 = (int *) 0x0
+ # $5 = (int (*)()) 0
+ # $6 = (int (*)()) 0x24 <function_bar>
+
+ gdb_test_multiple "print &${var}" "get address of ${var}" {
+ -re "\\\$\[0-9\]+ = \\(.*\\) (0|$hex)( <${var}>)?\[\r\n\]+${gdb_prompt} $"
+ {
+ pass "get address of ${var}"
+ if { $expect_out(1,string) == "0" } {
+ return "0x0"
+ } else {
+ return $expect_out(1,string)
+ }
+ }
+ }
+ return ""
+}
+
+# Return the frame number for the currently selected frame
+proc get_current_frame_number {{test_name ""}} {
+ global gdb_prompt
+
+ if { $test_name == "" } {
+ set test_name "get current frame number"
+ }
+ set frame_num -1
+ gdb_test_multiple "frame" $test_name {
+ -re "#(\[0-9\]+) .*$gdb_prompt $" {
+ set frame_num $expect_out(1,string)
+ }
+ }
+ return $frame_num
+}
+
# Get the current value for remotetimeout and return it.
proc get_remotetimeout { } {
global gdb_prompt
}
}
+# Get the target's current endianness and return it.
+proc get_endianness { } {
+ global gdb_prompt
+
+ gdb_test_multiple "show endian" "determine endianness" {
+ -re ".* (little|big) endian.*\r\n$gdb_prompt $" {
+ # Pass silently.
+ return $expect_out(1,string)
+ }
+ }
+ return "little"
+}
+
# ROOT and FULL are file names. Returns the relative path from ROOT
# to FULL. Note that FULL must be in a subdirectory of ROOT.
# For example, given ROOT = /usr/bin and FULL = /usr/bin/ls, this
if {[is_remote host]} {
unset GDB_PARALLEL
} else {
- file mkdir outputs temp cache
+ file mkdir \
+ [make_gdb_parallel_path outputs] \
+ [make_gdb_parallel_path temp] \
+ [make_gdb_parallel_path cache]
}
}
return $destcore
}
-# 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
-# for targets that use underscore as symbol prefix.
-# TODO: find out automatically if the target needs this.
+# 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 {
+ # Compile a simple test program...
+ set src { int main() { return 0; } }
+ if {![gdb_simple_compile target_symbol_prefix $src executable]} {
+ return 0
+ }
+
+ set prefix ""
+
+ set objdump_program [gdb_find_objdump]
+ set result [catch "exec $objdump_program --syms $obj" 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 $obj
+
+ return $prefix
+}
+
+# Return 1 if target supports scheduler locking, otherwise return 0.
+
+gdb_caching_proc target_supports_scheduler_locking {
+ global gdb_prompt
+
+ set me "gdb_target_supports_scheduler_locking"
+
+ set src { int main() { return 0; } }
+ if {![gdb_simple_compile $me $src executable]} {
+ return 0
+ }
+
+ clean_restart $obj
+ if ![runto_main] {
+ return 0
+ }
+
+ set supports_schedule_locking -1
+ set current_schedule_locking_mode ""
+
+ set test "reading current scheduler-locking mode"
+ gdb_test_multiple "show scheduler-locking" $test {
+ -re "Mode for locking scheduler during execution is \"(\[\^\"\]*)\".*$gdb_prompt" {
+ set current_schedule_locking_mode $expect_out(1,string)
+ }
+ -re "$gdb_prompt $" {
+ set supports_schedule_locking 0
+ }
+ timeout {
+ set supports_schedule_locking 0
+ }
+ }
+
+ if { $supports_schedule_locking == -1 } {
+ set test "checking for scheduler-locking support"
+ gdb_test_multiple "set scheduler-locking $current_schedule_locking_mode" $test {
+ -re "Target '\[^'\]+' cannot support this command\..*$gdb_prompt $" {
+ set supports_schedule_locking 0
+ }
+ -re "$gdb_prompt $" {
+ set supports_schedule_locking 1
+ }
+ timeout {
+ set supports_schedule_locking 0
+ }
+ }
+ }
+
+ if { $supports_schedule_locking == -1 } {
+ set supports_schedule_locking 0
+ }
+
+ gdb_exit
+ remote_file build delete $obj
+ verbose "$me: returning $supports_schedule_locking" 2
+ return $supports_schedule_locking
+}
+
+# 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_asm returns a string that can be
+# added to gdb_compile options to define the C-preprocessor macro
+# SYMBOL_PREFIX with a value that can be prepended to symbols
+# for targets which require a prefix, such as underscore.
+#
+# This version (_asm) defines the prefix without double quotes
+# 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
+# impossible to define a quote-stripping macro in C.)
+#
+# It's possible to use this version (_asm) for C/C++ source files too,
+# but a string is usually required in such files; providing a version
+# (no _asm) which encloses the prefix with double quotes makes it
+# somewhat easier to define the supporting macros in the test case.
+
+proc gdb_target_symbol_prefix_flags_asm {} {
+ set prefix [gdb_target_symbol_prefix]
+ if {$prefix ne ""} {
+ return "additional_flags=-DSYMBOL_PREFIX=$prefix"
+ } else {
+ return "";
+ }
+}
+
+# gdb_target_symbol_prefix_flags returns the same string as
+# gdb_target_symbol_prefix_flags_asm, above, but with the prefix
+# enclosed in double quotes if there is a prefix.
+#
+# See the comment for gdb_target_symbol_prefix_flags_asm for an
+# extended discussion.
proc gdb_target_symbol_prefix_flags {} {
- if { [istarget "i?86-*-cygwin*"] || [istarget "i?86-*-mingw*"]
- || [istarget "*-*-msdosdjgpp*"] || [istarget "*-*-go32*"] } {
- return "additional_flags=-DSYMBOL_PREFIX=\"_\""
+ set prefix [gdb_target_symbol_prefix]
+ if {$prefix ne ""} {
+ return "additional_flags=-DSYMBOL_PREFIX=\"$prefix\""
} else {
- return ""
+ return "";
}
}
# 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)
}
}
return [join $args "\r\n"]
}
+# Similar to the above, but while multi_line is meant to be used to
+# match GDB output, this one is meant to be used to build strings to
+# send as GDB input.
+
+proc multi_line_input { args } {
+ return [join $args "\n"]
+}
+
+# Return the version of the DejaGnu framework.
+#
+# The return value is a list containing the major, minor and patch version
+# numbers. If the version does not contain a minor or patch number, they will
+# be set to 0. For example:
+#
+# 1.6 -> {1 6 0}
+# 1.6.1 -> {1 6 1}
+# 2 -> {2 0 0}
+
+proc dejagnu_version { } {
+ # The frame_version variable is defined by DejaGnu, in runtest.exp.
+ global frame_version
+
+ verbose -log "DejaGnu version: $frame_version"
+ verbose -log "Expect version: [exp_version]"
+ verbose -log "Tcl version: [info tclversion]"
+
+ set dg_ver [split $frame_version .]
+
+ while { [llength $dg_ver] < 3 } {
+ lappend dg_ver 0
+ }
+
+ return $dg_ver
+}
+
+# Define user-defined command COMMAND using the COMMAND_LIST as the
+# command's definition. The terminating "end" is added automatically.
+
+proc gdb_define_cmd {command command_list} {
+ global gdb_prompt
+
+ set input [multi_line_input {*}$command_list "end"]
+ set test "define $command"
+
+ gdb_test_multiple "define $command" $test {
+ -re "End with" {
+ gdb_test_multiple $input $test {
+ -re "\r\n$gdb_prompt " {
+ }
+ }
+ }
+ }
+}
+
+# Override the 'cd' builtin with a version that ensures that the
+# log file keeps pointing at the same file. We need this because
+# unfortunately the path to the log file is recorded using an
+# relative path name, and, we sometimes need to close/reopen the log
+# after changing the current directory. See get_compiler_info.
+
+rename cd builtin_cd
+
+proc cd { dir } {
+
+ # Get the existing log file flags.
+ set log_file_info [log_file -info]
+
+ # Split the flags into args and file name.
+ set log_file_flags ""
+ set log_file_file ""
+ foreach arg [ split "$log_file_info" " "] {
+ if [string match "-*" $arg] {
+ lappend log_file_flags $arg
+ } else {
+ lappend log_file_file $arg
+ }
+ }
+
+ # If there was an existing file, ensure it is an absolute path, and then
+ # reset logging.
+ if { $log_file_file != "" } {
+ set log_file_file [file normalize $log_file_file]
+ log_file
+ log_file $log_file_flags "$log_file_file"
+ }
+
+ # Call the builtin version of cd.
+ builtin_cd $dir
+}
+
# Always load compatibility stuff.
load_lib future.exp
projects / deliverable / binutils-gdb.git / blobdiff