-# Copyright 1992-2013 Free Software Foundation, Inc.
+# Copyright 1992-2015 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
global GDB
+# The spawn ID used for I/O interaction with the inferior. For native
+# targets, or remote targets that can do I/O through GDB
+# (semi-hosting) this will be the same as the host/GDB's spawn ID.
+# Otherwise, the board may set this to some other spawn ID. E.g.,
+# when debugging with GDBserver, this is set to GDBserver's spawn ID,
+# so input/output is done on gdbserver's tty.
+global inferior_spawn_id
+
if [info exists TOOL_EXECUTABLE] {
set GDB $TOOL_EXECUTABLE
}
}
# The variable gdb_prompt is a regexp which matches the gdb prompt.
-# Set it if it is not already set.
+# Set it if it is not already set. This is also set by default_gdb_init
+# but it's not clear what removing one of them will break.
+# See with_gdb_prompt for more details on prompt handling.
global gdb_prompt
if ![info exists gdb_prompt] then {
- set gdb_prompt "\[(\]gdb\[)\]"
+ set gdb_prompt "\\(gdb\\)"
}
+# A regexp that matches the pagination prompt.
+set pagination_prompt [string_to_regexp "---Type <return> to continue, or q <return> to quit---"]
+
# The variable fullname_syntax_POSIX is a regexp which matches a POSIX
# absolute path ie. /foo/
set fullname_syntax_POSIX {/[^\n]*/}
# we need a larger timeout value here or this thing just confuses
# itself. May need a better implementation if possible. - guo
#
- send_gdb "delete breakpoints\n"
- gdb_expect 100 {
- -re "Delete all breakpoints.*y or n.*$" {
+ set timeout 100
+
+ set msg "delete all breakpoints in delete_breakpoints"
+ set deleted 0
+ gdb_test_multiple "delete breakpoints" "$msg" {
+ -re "Delete all breakpoints.*y or n.*$" {
send_gdb "y\n"
exp_continue
}
- -re "$gdb_prompt $" { # This happens if there were no breakpoints
- }
- timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
+ -re "$gdb_prompt $" {
+ set deleted 1
+ }
}
- send_gdb "info breakpoints\n"
- gdb_expect 100 {
- -re "No breakpoints or watchpoints..*$gdb_prompt $" {}
- -re "$gdb_prompt $" { perror "breakpoints not deleted" ; return }
- -re "Delete all breakpoints.*or n.*$" {
- send_gdb "y\n"
- exp_continue
+
+ if {$deleted} {
+ # Confirm with "info breakpoints".
+ set deleted 0
+ set msg "info breakpoints"
+ gdb_test_multiple $msg $msg {
+ -re "No breakpoints or watchpoints..*$gdb_prompt $" {
+ set deleted 1
+ }
+ -re "$gdb_prompt $" {
+ }
}
- timeout { perror "info breakpoints (timeout)" ; return }
+ }
+
+ if {!$deleted} {
+ perror "breakpoints not deleted"
}
}
proc gdb_run_cmd {args} {
global gdb_prompt use_gdb_stub
- if [target_info exists gdb_init_command] {
- send_gdb "[target_info gdb_init_command]\n"
+ foreach command [gdb_init_commands] {
+ send_gdb "$command\n"
gdb_expect 30 {
-re "$gdb_prompt $" { }
default {
proc gdb_start_cmd {args} {
global gdb_prompt use_gdb_stub
- if [target_info exists gdb_init_command] {
- send_gdb "[target_info gdb_init_command]\n"
+ foreach command [gdb_init_commands] {
+ send_gdb "$command\n"
gdb_expect 30 {
-re "$gdb_prompt $" { }
default {
global gdb_prompt
set full_name "continue to breakpoint: $name"
- send_gdb "continue\n"
- gdb_expect {
+ gdb_test_multiple "continue" $full_name {
-re "(?:Breakpoint|Temporary breakpoint) .* (at|in) $location_pattern\r\n$gdb_prompt $" {
pass $full_name
}
- -re ".*$gdb_prompt $" {
- fail $full_name
- }
- timeout {
- fail "$full_name (timeout)"
- }
}
}
# }
# }
#
+# Like with "expect", you can also specify the spawn id to match with
+# -i "$id". Interesting spawn ids are $inferior_spawn_id and
+# $gdb_spawn_id. The former matches inferior I/O, while the latter
+# matches GDB I/O. E.g.:
+#
+# send_inferior "hello\n"
+# gdb_test_multiple "continue" "test echo" {
+# -i "$inferior_spawn_id" -re "^hello\r\nhello\r\n$" {
+# pass "got echo"
+# }
+# -i "$gdb_spawn_id" -re "Breakpoint.*$gdb_prompt $" {
+# fail "hit breakpoint"
+# }
+# }
+#
# The standard patterns, such as "Inferior exited..." and "A problem
-# ...", all being implicitly appended to that list.
+# ...", all being implicitly appended to that list. These are always
+# expected from $gdb_spawn_id. IOW, callers do not need to worry
+# about resetting "-i" back to $gdb_spawn_id explicitly.
#
proc gdb_test_multiple { command message user_code } {
global verbose use_gdb_stub
- global gdb_prompt
+ global gdb_prompt pagination_prompt
global GDB
+ global gdb_spawn_id
global inferior_exited_re
upvar timeout timeout
upvar expect_out expect_out
+ global any_spawn_id
if { $message == "" } {
set message $command
lappend processed_code $item
continue
}
- if { $item == "-timeout" } {
+ if { $item == "-timeout" || $item == "-i" } {
set expecting_arg 1
lappend processed_code $item
continue
}
if { $expecting_arg } {
set expecting_arg 0
- lappend processed_code $item
+ lappend processed_code $subst_item
continue
}
if { $expecting_action } {
}
}
- if [target_info exists gdb,timeout] {
- set tmt [target_info gdb,timeout]
- } else {
- if [info exists timeout] {
- set tmt $timeout
- } else {
- global timeout
- if [info exists timeout] {
- set tmt $timeout
- } else {
- set tmt 60
- }
- }
- }
-
set code {
-re ".*A problem internal to GDB has been detected" {
fail "$message (GDB internal error)"
gdb_internal_error_resync
+ set result -1
}
-re "\\*\\*\\* DOSEXIT code.*" {
if { $message != "" } {
}
append code $processed_code
append code {
+ # Reset the spawn id, in case the processed code used -i.
+ -i "$gdb_spawn_id"
+
-re "Ending remote debugging.*$gdb_prompt $" {
if ![isnative] then {
warning "Can`t communicate to remote target."
}
set result 1
}
- "<return>" {
+ -re "$pagination_prompt" {
send_gdb "\n"
perror "Window too small."
fail "$message"
fail "$message (got breakpoint menu)"
set result -1
}
+
+ # Patterns below apply to any spawn id specified.
+ -i $any_spawn_id
eof {
perror "Process no longer exists"
if { $message != "" } {
}
set result 0
- set code [catch {gdb_expect $tmt $code} string]
+ set code [catch {gdb_expect $code} string]
if {$code == 1} {
global errorInfo errorCode
return -code error -errorinfo $errorInfo -errorcode $errorCode $string
}
}
\f
-# Given an input string, adds backslashes as needed to create a
-# regexp that will match the string.
-
-proc string_to_regexp {str} {
- set result $str
- regsub -all {[]*+.|()^$\[\\]} $str {\\&} result
- return $result
-}
# Same as gdb_test, but the second parameter is not a regexp,
# but a string that must match exactly.
}
}
}
+
+# 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
+# frame returns true, and issue a FAIL and return false otherwise.
+# MESSAGE is the pass/fail message to be printed. If MESSAGE is
+# omitted or is empty, then the pass/fail messages use the condition
+# string as the message.
+
+proc gdb_assert { condition {message ""} } {
+ if { $message == ""} {
+ set message $condition
+ }
+
+ set res [uplevel 1 expr $condition]
+ if {!$res} {
+ fail $message
+ } else {
+ pass $message
+ }
+ return $res
+}
+
proc gdb_reinitialize_dir { subdir } {
global gdb_prompt
}
}
-#
-# start gdb -- start gdb running, default procedure
-#
-# 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.
-#
-proc default_gdb_start { } {
- global verbose use_gdb_stub
+# Default gdb_spawn procedure.
+
+proc default_gdb_spawn { } {
+ global use_gdb_stub
global GDB
global INTERNAL_GDBFLAGS GDBFLAGS
- global gdb_prompt
- global timeout
global gdb_spawn_id
gdb_stop_suppressing_tests
perror "Spawning $GDB failed."
return 1
}
- gdb_expect 360 {
- -re "\[\r\n\]$gdb_prompt $" {
- verbose "GDB initialized."
- }
- -re "$gdb_prompt $" {
- perror "GDB never initialized."
- return -1
- }
- timeout {
- perror "(timeout) GDB never initialized after 10 seconds."
- remote_close host
- return -1
+
+ set gdb_spawn_id $res
+ return 0
+}
+
+# Default gdb_start procedure.
+
+proc default_gdb_start { } {
+ global gdb_prompt pagination_prompt
+ global gdb_spawn_id
+ global inferior_spawn_id
+
+ if [info exists gdb_spawn_id] {
+ return 0
+ }
+
+ set res [gdb_spawn]
+ if { $res != 0} {
+ return $res
+ }
+
+ # Default to assuming inferior I/O is done on GDB's terminal.
+ if {![info exists inferior_spawn_id]} {
+ set inferior_spawn_id $gdb_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
+ }
}
}
- set gdb_spawn_id -1
+
# force the height to "unlimited", so no pagers get used
send_gdb "set height 0\n"
return 0
}
+# Utility procedure to give user control of the gdb prompt in a script. It is
+# meant to be used for debugging test cases, and should not be left in the
+# test cases code.
+
+proc gdb_interact { } {
+ global gdb_spawn_id
+ set spawn_id $gdb_spawn_id
+
+ send_user "+------------------------------------------+\n"
+ send_user "| Script interrupted, you can now interact |\n"
+ send_user "| with by gdb. Type >>> to continue. |\n"
+ send_user "+------------------------------------------+\n"
+
+ interact {
+ ">>>" return
+ }
+}
+
# Examine the output of compilation to determine whether compilation
# failed or not. If it failed determine whether it is due to missing
# compiler or due to compiler error. Report pass, fail or unsupported
return 0
}
+# Return a 1 if I don't even want to try to test D.
+
+proc skip_d_tests {} {
+ return 0
+}
+
# Return a 1 for configurations that do not support Python scripting.
proc skip_python_tests {} {
return 1
}
+# Return 1 if we should skip tui related tests.
+
+proc skip_tui_tests {} {
+ global gdb_prompt
+
+ gdb_test_multiple "help layout" "verify tui support" {
+ -re "Undefined command: \"layout\".*$gdb_prompt $" {
+ return 1
+ }
+ -re "$gdb_prompt $" {
+ }
+ }
+
+ return 0
+}
+
# Test files shall make sure all the test result lines in gdb.sum are
# unique in a test run, so that comparing the gdb.sum files of two
# test runs gives correct results. Test files that exercise
}
}
+# 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.
+# Returns the result of BODY.
+#
+# Notes:
+#
+# 1) If you want to use, for example, "(foo)" as the prompt you must pass it
+# as "(foo)", and not the regexp form "\(foo\)" (expressed as "\\(foo\\)" in
+# TCL). PROMPT is internally converted to a suitable regexp for matching.
+# We do the conversion from "(foo)" to "\(foo\)" here for a few reasons:
+# a) It's more intuitive for callers to pass the plain text form.
+# b) We need two forms of the prompt:
+# - a regexp to use in output matching,
+# - a value to pass to the "set prompt" command.
+# c) It's easier to convert the plain text form to its regexp form.
+#
+# 2) Don't add a trailing space, we do that here.
+
+proc with_gdb_prompt { prompt body } {
+ global gdb_prompt
+
+ # Convert "(foo)" to "\(foo\)".
+ # We don't use string_to_regexp because while it works today it's not
+ # clear it will work tomorrow: the value we need must work as both a
+ # regexp *and* as the argument to the "set prompt" command, at least until
+ # we start recording both forms separately instead of just $gdb_prompt.
+ # The testsuite is pretty-much hardwired to interpret $gdb_prompt as the
+ # regexp form.
+ regsub -all {[]*+.|()^$\[\\]} $prompt {\\&} prompt
+
+ set saved $gdb_prompt
+
+ verbose -log "Setting gdb prompt to \"$prompt \"."
+ set gdb_prompt $prompt
+ gdb_test_no_output "set prompt $prompt " ""
+
+ set code [catch {uplevel 1 $body} result]
+
+ verbose -log "Restoring gdb prompt to \"$saved \"."
+ set gdb_prompt $saved
+ gdb_test_no_output "set prompt $saved " ""
+
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
+# Run tests in BODY with target-charset setting to TARGET_CHARSET. When
+# BODY is finished, restore target-charset.
+
+proc with_target_charset { target_charset body } {
+ global gdb_prompt
+
+ set saved ""
+ gdb_test_multiple "show target-charset" "" {
+ -re "The target character set is \".*; currently (.*)\"\..*$gdb_prompt " {
+ set saved $expect_out(1,string)
+ }
+ -re "The target character set is \"(.*)\".*$gdb_prompt " {
+ set saved $expect_out(1,string)
+ }
+ -re ".*$gdb_prompt " {
+ fail "get target-charset"
+ }
+ }
+
+ gdb_test_no_output "set target-charset $target_charset" ""
+
+ set code [catch {uplevel 1 $body} result]
+
+ gdb_test_no_output "set target-charset $saved" ""
+
+ 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,
+# - the board variable "gdb,timeout".
+
+proc get_largest_timeout {} {
+ upvar #0 timeout gtimeout
+ upvar 2 timeout timeout
+
+ set tmt 0
+ if [info exists timeout] {
+ set tmt $timeout
+ }
+ if { [info exists gtimeout] && $gtimeout > $tmt } {
+ set tmt $gtimeout
+ }
+ if { [target_info exists gdb,timeout]
+ && [target_info gdb,timeout] > $tmt } {
+ set tmt [target_info gdb,timeout]
+ }
+ if { $tmt == 0 } {
+ # Eeeeew.
+ set tmt 60
+ }
+
+ return $tmt
+}
+
+# Run tests in BODY with timeout increased by factor of FACTOR. When
+# BODY is finished, restore timeout.
+
+proc with_timeout_factor { factor body } {
+ global timeout
+
+ set savedtimeout $timeout
+
+ set timeout [expr [get_largest_timeout] * $factor]
+ set code [catch {uplevel 1 $body} result]
+
+ set timeout $savedtimeout
+ if {$code == 1} {
+ global errorInfo errorCode
+ return -code $code -errorinfo $errorInfo -errorcode $errorCode $result
+ } else {
+ return -code $code $result
+ }
+}
+
# Return 1 if _Complex types are supported, otherwise, return 0.
gdb_caching_proc support_complex_tests {
set src [standard_temp_file complex[pid].c]
set exe [standard_temp_file complex[pid].x]
- set f [open $src "w"]
- puts $f "int main() {"
- puts $f "_Complex float cf;"
- puts $f "_Complex double cd;"
- puts $f "_Complex long double cld;"
- puts $f " return 0; }"
- close $f
+ gdb_produce_source $src {
+ 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}
return $result
}
+# Return 1 if GDB can get a type for siginfo from the target, otherwise
+# return 0.
+
+proc supports_get_siginfo_type {} {
+ if { [istarget "*-*-linux*"] } {
+ return 1
+ } else {
+ return 0
+ }
+}
+
# Return 1 if target hardware or OS supports single stepping to signal
# handler, otherwise, return 0.
# 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 "tic6x-*-*"] || [istarget "sparc*-*-linux*"]
+ || [istarget "nios2-*-*"] } {
return 0
}
return [target_info gdb,use_precord]
}
- if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+ if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
+ || [istarget "i\[34567\]86-*-linux*"]
+ || [istarget "aarch64*-*-linux*"]
+ || [istarget "powerpc*-*-linux*"] } {
return 1
}
return [target_info gdb,can_reverse]
}
- if { [istarget "x86_64-*-linux*"] || [istarget "i\[34567\]86-*-linux*"] } {
+ if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
+ || [istarget "i\[34567\]86-*-linux*"]
+ || [istarget "aarch64*-*-linux*"]
+ || [istarget "powerpc*-*-linux*"] } {
return 1
}
return 0
}
+# Return 1 if readline library is used.
+
+proc readline_is_used { } {
+ global gdb_prompt
+
+ gdb_test_multiple "show editing" "" {
+ -re ".*Editing of command lines as they are typed is on\..*$gdb_prompt $" {
+ return 1
+ }
+ -re ".*$gdb_prompt $" {
+ return 0
+ }
+ }
+}
+
+# Return 1 if target is ELF.
+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 fp_obj [open $obj "r"]
+ fconfigure $fp_obj -translation binary
+ set data [read $fp_obj]
+ close $fp_obj
+
+ file delete $obj
+
+ set ELFMAG "\u007FELF"
+
+ if {[string compare -length 4 $data $ELFMAG] != 0} {
+ verbose "$me: returning 0" 2
+ return 0
+ }
+
+ verbose "$me: returning 1" 2
+ return 1
+}
+
+# Return 1 if the memory at address zero is readable.
+
+gdb_caching_proc is_address_zero_readable {
+ global gdb_prompt
+
+ set ret 0
+ gdb_test_multiple "x 0" "" {
+ -re "Cannot access memory at address 0x0.*$gdb_prompt $" {
+ set ret 0
+ }
+ -re ".*$gdb_prompt $" {
+ set ret 1
+ }
+ }
+
+ return $ret
+}
+
+# Produce source file NAME and write SOURCES into it.
+
+proc gdb_produce_source { name sources } {
+ set index 0
+ set f [open $name "w"]
+
+ puts $f $sources
+ close $f
+}
+
# Return 1 if target is ILP32.
# This cannot be decided simply from looking at the target string,
# as it might depend on externally passed compiler options like -m64.
set src [standard_temp_file ilp32[pid].c]
set obj [standard_temp_file ilp32[pid].o]
- set f [open $src "w"]
- puts $f "int dummy\[sizeof (int) == 4"
- puts $f " && sizeof (void *) == 4"
- puts $f " && sizeof (long) == 4 ? 1 : -1\];"
- close $f
+ gdb_produce_source $src {
+ 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}]
set src [standard_temp_file lp64[pid].c]
set obj [standard_temp_file lp64[pid].o]
- set f [open $src "w"]
- puts $f "int dummy\[sizeof (int) == 4"
- puts $f " && sizeof (void *) == 8"
- puts $f " && sizeof (long) == 8 ? 1 : -1\];"
- close $f
+ gdb_produce_source $src {
+ 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}]
set src [standard_temp_file is64[pid].c]
set obj [standard_temp_file is64[pid].o]
- set f [open $src "w"]
- puts $f "int function(void) { return 3; }"
- puts $f "int dummy\[sizeof (&function) == 8 ? 1 : -1\];"
- close $f
+ gdb_produce_source $src {
+ 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}]
set src [standard_temp_file reg64[pid].s]
set obj [standard_temp_file reg64[pid].o]
- set f [open $src "w"]
+ set list {}
foreach reg \
- {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
- puts $f "\tincq %$reg"
- }
- close $f
+ {rax rbx rcx rdx rsi rdi rbp rsp r8 r9 r10 r11 r12 r13 r14 r15} {
+ lappend list "\tincq %$reg"
+ }
+ gdb_produce_source $src [join $list \n]
verbose "$me: compiling testfile $src" 2
set lines [gdb_compile $src $obj object {quiet}]
return [expr [is_ilp32_target] && ![is_amd64_regs_target]]
}
+# Return 1 if this target is an arm or aarch32 on aarch64.
+
+gdb_caching_proc is_aarch32_target {
+ if { [istarget "arm*-*-*"] } {
+ return 1
+ }
+
+ if { ![istarget "aarch64*-*-*"] } {
+ 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 1 if this target is an aarch64, either lp64 or ilp32.
+
+proc is_aarch64_target {} {
+ if { ![istarget "aarch64*-*-*"] } {
+ return 0
+ }
+
+ return [expr ![is_aarch32_target]]
+}
+
# Return 1 if displaced stepping is supported on target, otherwise, return 0.
proc support_displaced_stepping {} {
set src [standard_temp_file vmx[pid].c]
set exe [standard_temp_file vmx[pid].x]
- set f [open $src "w"]
- puts $f "int main() {"
- puts $f "#ifdef __MACH__"
- puts $f " asm volatile (\"vor v0,v0,v0\");"
- puts $f "#else"
- puts $f " asm volatile (\"vor 0,0,0\");"
- puts $f "#endif"
- puts $f " return 0; }"
- close $f
+ gdb_produce_source $src {
+ int main() {
+ #ifdef __MACH__
+ asm volatile ("vor v0,v0,v0");
+ #else
+ asm volatile ("vor 0,0,0");
+ #endif
+ return 0;
+ }
+ }
verbose "$me: compiling testfile $src" 2
set lines [gdb_compile $src $exe executable $compile_flags]
set src [standard_temp_file vsx[pid].c]
set exe [standard_temp_file vsx[pid].x]
- set f [open $src "w"]
- puts $f "int main() {"
- puts $f " double a\[2\] = { 1.0, 2.0 };"
- puts $f "#ifdef __MACH__"
- puts $f " asm volatile (\"lxvd2x v0,v0,%\[addr\]\" : : \[addr\] \"r\" (a));"
- puts $f "#else"
- puts $f " asm volatile (\"lxvd2x 0,0,%\[addr\]\" : : \[addr\] \"r\" (a));"
- puts $f "#endif"
- puts $f " return 0; }"
- close $f
+ gdb_produce_source $src {
+ int main() {
+ double a[2] = { 1.0, 2.0 };
+ #ifdef __MACH__
+ asm volatile ("lxvd2x v0,v0,%[addr]" : : [addr] "r" (a));
+ #else
+ asm volatile ("lxvd2x 0,0,%[addr]" : : [addr] "r" (a));
+ #endif
+ return 0;
+ }
+ }
verbose "$me: compiling testfile $src" 2
set lines [gdb_compile $src $exe executable $compile_flags]
return $skip_vsx_tests
}
+# Run a test on the target to see if it supports TSX hardware. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+gdb_caching_proc skip_tsx_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_tsx_tests"
+
+ set src [standard_temp_file tsx[pid].c]
+ set exe [standard_temp_file tsx[pid].x]
+
+ gdb_produce_source $src {
+ int main() {
+ asm volatile ("xbegin .L0");
+ asm volatile ("xend");
+ asm volatile (".L0: nop");
+ return 0;
+ }
+ }
+
+ verbose "$me: compiling testfile $src" 2
+ set lines [gdb_compile $src $exe executable {nowarnings quiet}]
+ file delete $src
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed." 2
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$exe"
+ gdb_run_cmd
+ gdb_expect {
+ -re ".*Illegal instruction.*${gdb_prompt} $" {
+ verbose -log "$me: TSX hardware not detected."
+ set skip_tsx_tests 1
+ }
+ -re ".*$inferior_exited_re normally.*${gdb_prompt} $" {
+ verbose -log "$me: TSX hardware detected."
+ set skip_tsx_tests 0
+ }
+ default {
+ warning "\n$me: default case taken."
+ set skip_tsx_tests 1
+ }
+ }
+ gdb_exit
+ remote_file build delete $exe
+
+ verbose "$me: returning $skip_tsx_tests" 2
+ return $skip_tsx_tests
+}
+
# Run a test on the target to see if it supports btrace hardware. Return 0 if so,
# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
set src [standard_temp_file btrace[pid].c]
set exe [standard_temp_file btrace[pid].x]
- set f [open $src "w"]
- puts $f "int main(void) { return 0; }"
- close $f
+ gdb_produce_source $src {
+ int main(void) { return 0; }
+ }
verbose "$me: compiling testfile $src" 2
set compile_flags {debug nowarnings quiet}
return $skip_btrace_tests
}
+# Run a test on the target to see if it supports btrace pt hardware.
+# Return 0 if so, 1 if it does not. Based on 'check_vmx_hw_available'
+# from the GCC testsuite.
+
+gdb_caching_proc skip_btrace_pt_tests {
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ set me "skip_btrace_tests"
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support btrace, returning 1" 2
+ return 1
+ }
+
+ # Set up, compile, and execute a test program.
+ # Include the current process ID in the file names to prevent conflicts
+ # with invocations for multiple testsuites.
+ set src [standard_temp_file btrace[pid].c]
+ set exe [standard_temp_file btrace[pid].x]
+
+ gdb_produce_source $src {
+ int main(void) { return 0; }
+ }
+
+ verbose "$me: compiling testfile $src" 2
+ set compile_flags {debug nowarnings quiet}
+ set lines [gdb_compile $src $exe executable $compile_flags]
+
+ if ![string match "" $lines] then {
+ verbose "$me: testfile compilation failed, returning 1" 2
+ file delete $src
+ return 1
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load $exe
+ if ![runto_main] {
+ file delete $src
+ return 1
+ }
+ file delete $src
+ # In case of an unexpected output, we return 2 as a fail value.
+ set skip_btrace_tests 2
+ gdb_test_multiple "record btrace pt" "check btrace support" {
+ -re "You can't do that when your target is.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "Target does not support branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests 1
+ }
+ -re "^record btrace pt\r\n$gdb_prompt $" {
+ set skip_btrace_tests 0
+ }
+ }
+ gdb_exit
+ remote_file build delete $exe
+
+ verbose "$me: returning $skip_btrace_tests" 2
+ return $skip_btrace_tests
+}
+
# Skip all the tests in the file if you are not on an hppa running
# hpux target.
if { [istarget "i?86-*-*"]
|| [istarget "x86_64-*-*"]
|| [istarget "ia64-*-*"]
- || [istarget "arm*-*-*"]} {
+ || [istarget "arm*-*-*"]
+ || [istarget "aarch64*-*-*"]} {
return 0
}
|| [istarget "x86_64-*-*"]
|| [istarget "ia64-*-*"]
|| [istarget "arm*-*-*"]
+ || [istarget "aarch64*-*-*"]
|| [istarget "powerpc*-*-linux*"]
|| [istarget "s390*-*-*"] } {
return 0
}
-re "No symbol .* in current context.\r\n$gdb_prompt $" {
}
- }
- if {!$ok} {
- gdb_test_multiple "info probe" "check for stap probe in unwinder" {
- -re ".*libgcc.*unwind.*\r\n$gdb_prompt $" {
- set ok 1
- }
- -re "\r\n$gdb_prompt $" {
- }
+ }
+ if {!$ok} {
+ gdb_test_multiple "info probe" "check for stap probe in unwinder" {
+ -re ".*libgcc.*unwind.*\r\n$gdb_prompt $" {
+ set ok 1
+ }
+ -re "\r\n$gdb_prompt $" {
+ }
+ }
+ }
+ return $ok
+}
+
+# Return 0 if we should skip tests that require the libstdc++ stap
+# probes. This must be invoked while gdb is running, after shared
+# libraries have been loaded.
+
+proc skip_libstdcxx_probe_tests {} {
+ global gdb_prompt
+
+ set ok 0
+ gdb_test_multiple "info probe" "check for stap probe in libstdc++" {
+ -re ".*libstdcxx.*catch.*\r\n$gdb_prompt $" {
+ set ok 1
+ }
+ -re "\r\n$gdb_prompt $" {
+ }
+ }
+ return $ok
+}
+
+# Return 1 if we should skip tests of the "compile" feature.
+# This must be invoked after the inferior has been started.
+
+proc skip_compile_feature_tests {} {
+ global gdb_prompt
+
+ set result 0
+ gdb_test_multiple "compile code -- ;" "check for working compile command" {
+ "Could not load libcc1.*\r\n$gdb_prompt $" {
+ set result 1
+ }
+ -re "Command not supported on this host\\..*\r\n$gdb_prompt $" {
+ set result 1
+ }
+ -re "\r\n$gdb_prompt $" {
+ }
+ }
+ return $result
+}
+
+# Check whether we're testing with the remote or extended-remote
+# targets.
+
+proc gdb_is_target_remote {} {
+ global gdb_prompt
+
+ set test "probe for target remote"
+ gdb_test_multiple "maint print target-stack" $test {
+ -re ".*emote serial target in gdb-specific protocol.*$gdb_prompt $" {
+ pass $test
+ return 1
+ }
+ -re "$gdb_prompt $" {
+ pass $test
}
}
- return $ok
+ return 0
}
-# Return 0 if we should skip tests that require the libstdc++ stap
-# probes. This must be invoked while gdb is running, after shared
-# libraries have been loaded.
+# 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.
-proc skip_libstdcxx_probe_tests {} {
+gdb_caching_proc target_is_gdbserver {
global gdb_prompt
- set ok 0
- gdb_test_multiple "info probe" "check for stap probe in libstdc++" {
- -re ".*libstdcxx.*catch.*\r\n$gdb_prompt $" {
- set ok 1
+ set is_gdbserver -1
+ set test "Probing for GDBserver"
+
+ gdb_test_multiple "monitor help" $test {
+ -re "The following monitor commands are supported.*Quit GDBserver.*$gdb_prompt $" {
+ set is_gdbserver 1
}
- -re "\r\n$gdb_prompt $" {
+ -re "$gdb_prompt $" {
+ set is_gdbserver 0
}
}
- return $ok
+
+ if { $is_gdbserver == -1 } {
+ verbose -log "Unable to tell whether we are using GDBserver or not."
+ }
+
+ return $is_gdbserver
+}
+
+# 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 compiler_info "unknown"
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.
#
# if the build machine is the same as the host machine, which is
# usually true of the targets which are not gcc. But this code does
# not figure which compiler to call, and it always ends up using the C
-# compiler. Not good for setting hp_aCC_compiler. Targets
-# hppa*-*-hpux* and mips*-*-irix* used to do this.
+# compiler. Not good for setting hp_aCC_compiler. Target
+# hppa*-*-hpux* used to do this.
#
# [ gdb_compile -E $ifile > $binfile.ci ]
# source $binfile.ci
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"
if { $arg == "c++" } {
# Run $ifile through the right preprocessor.
# Toggle gdb.log to keep the compiler output out of the log.
+ set saved_log [log_file -info]
log_file
if [is_remote host] {
# We have to use -E and -o together, despite the comments
} else {
set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ]
}
- log_file -a "$outdir/$tool.log"
+ eval log_file $saved_log
# Eval the output.
set unknown 0
}
}
- # 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"
}
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]
}
|| [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" } {
set shlib_load 1
}
set options $new_options
- if [target_info exists is_vxworks] {
- set options2 { "additional_flags=-Dvxworks" }
- set options [concat $options2 $options]
- }
if [info exists GDB_TESTCASE_OPTIONS] {
lappend options "additional_flags=$GDB_TESTCASE_OPTIONS"
}
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile $source: ${why_msg}"
+ unsupported "Couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
-# Build a shared library from SOURCES. You must use get_compiler_info
-# first.
+# Build a shared library from SOURCES.
proc gdb_compile_shlib {sources dest options} {
set obj_options $options
+ set info_options ""
+ if { [lsearch -exact $options "c++"] >= 0 } {
+ set info_options "c++"
+ }
+ if [get_compiler_info ${info_options}] {
+ return -1
+ }
+
switch -glob [test_compiler_info] {
"xlc-*" {
lappend obj_options "additional_flags=-qpic"
}
+ "clang-*" {
+ if { !([istarget "*-*-cygwin*"]
+ || [istarget "*-*-mingw*"]) } {
+ lappend obj_options "additional_flags=-fpic"
+ }
+ }
"gcc-*" {
if { !([istarget "powerpc*-*-aix*"]
|| [istarget "rs6000*-*-aix*"]
"hppa*-hp-hpux*" {
lappend obj_options "additional_flags=+z"
}
- "mips-sgi-irix*" {
- # Disable SGI compiler's implicit -Dsgi
- lappend obj_options "additional_flags=-Usgi"
- }
default {
# don't know what the compiler is...
}
}
}
if {!$built_binfile} {
- unsupported "Couldn't compile $source: ${why_msg}"
+ unsupported "Couldn't compile [file tail $source]: ${why_msg}"
return -1
}
}
return [remote_send host "$string"]
}
+# Send STRING to the inferior's terminal.
+
+proc send_inferior { string } {
+ global inferior_spawn_id
+
+ if {[catch "send -i $inferior_spawn_id -- \$string" errorInfo]} {
+ return "$errorInfo"
+ } else {
+ return ""
+ }
+}
+
#
#
set expcode $args
}
- upvar timeout timeout
-
- if [target_info exists gdb,timeout] {
- if [info exists timeout] {
- if { $timeout < [target_info gdb,timeout] } {
- set gtimeout [target_info gdb,timeout]
- } else {
- set gtimeout $timeout
- }
- } else {
- set gtimeout [target_info gdb,timeout]
- }
- }
-
- if ![info exists gtimeout] {
- global timeout
- if [info exists timeout] {
- set gtimeout $timeout
- }
- }
-
+ # A timeout argument takes precedence, otherwise of all the timeouts
+ # select the largest.
if [info exists atimeout] {
- if { ![info exists gtimeout] || $gtimeout < $atimeout } {
- set gtimeout $atimeout
- }
+ set tmt $atimeout
} else {
- if ![info exists gtimeout] {
- # Eeeeew.
- set gtimeout 60
- }
+ set tmt [get_largest_timeout]
}
global suppress_flag
}
}
set code [catch \
- {uplevel remote_expect host $gtimeout $expcode} string]
+ {uplevel remote_expect host $tmt $expcode} string]
if [info exists old_val] {
set remote_suppress_flag $old_val
} else {
set suppress_flag 0
}
+# Spawn the gdb process.
+#
+# This doesn't expect any output or do any other initialization,
+# leaving those to the caller.
+#
+# Overridable function -- you can override this function in your
+# baseboard file.
+
+proc gdb_spawn { } {
+ default_gdb_spawn
+}
+
+# Spawn GDB with CMDLINE_FLAGS appended to the GDBFLAGS global.
+
+proc gdb_spawn_with_cmdline_opts { cmdline_flags } {
+ global GDBFLAGS
+
+ set saved_gdbflags $GDBFLAGS
+
+ if {$GDBFLAGS != ""} {
+ append GDBFLAGS " "
+ }
+ append GDBFLAGS $cmdline_flags
+
+ set res [gdb_spawn]
+
+ set GDBFLAGS $saved_gdbflags
+
+ return $res
+}
+
+# Start gdb running, wait for prompt, and disable the pagers.
+
+# Overridable function -- you can override this function in your
+# baseboard file.
+
proc gdb_start { } {
default_gdb_start
}
catch default_gdb_exit
}
+# Return true if we can spawn a program on the target and attach to
+# it.
+
+proc can_spawn_for_attach { } {
+ # 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
+ }
+
+ # The "attach" command doesn't make sense when the target is
+ # stub-like, where GDB finds the program already started on
+ # initial connection.
+ if {[target_info exists use_gdb_stub]} {
+ return 0
+ }
+
+ # Assume yes.
+ 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 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 spawn_id_list {}
+
+ if ![can_spawn_for_attach] {
+ # The caller should have checked can_spawn_for_attach itself
+ # before getting here.
+ error "can't spawn for attach with this target/board"
+ }
+
+ foreach {executable} $executable_list {
+ # 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
+
+ return $spawn_id_list
+}
+
#
# gdb_load_cmd -- load a file into the debugger.
# ARGS - additional args to load command.
pass $test
set result 1
}
-
- -re "Undefined command.*$gdb_prompt $" {
- unsupported $test
- verbose -log "'gcore' command undefined in gdb_gcore_cmd"
- }
-
- -re "Can't create a corefile\[\r\n\]+$gdb_prompt $" {
+ -re "(?:Can't create a corefile|Target does not support core file generation\\.)\[\r\n\]+$gdb_prompt $" {
unsupported $test
}
}
}
#
-# gdb_load -- load a file into the debugger.
+# gdb_load -- load a file into the debugger. Specifying no file
+# defaults to the executable currently being debugged.
+# The return value is 0 for success, -1 for failure.
# Many files in config/*.exp override this procedure.
#
proc gdb_load { arg } {
- return [gdb_file_cmd $arg]
+ if { $arg != "" } {
+ return [gdb_file_cmd $arg]
+ }
+ return 0
}
# gdb_reload -- load a file into the target. Called before "running",
return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"]
}
-proc default_gdb_init { args } {
+proc default_gdb_init { test_file_name } {
global gdb_wrapper_initialized
global gdb_wrapper_target
global gdb_test_file_name
global cleanfiles
+ global pf_prefix
set cleanfiles {}
gdb_clear_suppressed
- set gdb_test_file_name [file rootname [file tail [lindex $args 0]]]
+ set gdb_test_file_name [file rootname [file tail $test_file_name]]
# Make sure that the wrapper is rebuilt
# with the appropriate multilib option.
# Unlike most tests, we have a small number of tests that generate
# a very large amount of output. We therefore increase the expect
- # buffer size to be able to contain the entire test output.
- match_max -d 30000
+ # buffer size to be able to contain the entire test output. This
+ # is especially needed by gdb.base/info-macros.exp.
+ match_max -d 65536
# Also set this value for the currently running GDB.
match_max [match_max -d]
# We want to add the name of the TCL testcase to the PASS/FAIL messages.
- if { [llength $args] > 0 } {
- global pf_prefix
+ set pf_prefix "[file tail [file dirname $test_file_name]]/[file tail $test_file_name]:"
- set file [lindex $args 0]
-
- set pf_prefix "[file tail [file dirname $file]]/[file tail $file]:"
- }
global gdb_prompt
if [target_info exists gdb_prompt] {
set gdb_prompt [target_info gdb_prompt]
}
}
+# Return a path using GDB_PARALLEL.
+# ARGS is a list of path elements to append to "$objdir/$GDB_PARALLEL".
+# GDB_PARALLEL must be defined, the caller must check.
+#
+# The default value for GDB_PARALLEL is, canonically, ".".
+# The catch is that tests don't expect an additional "./" in file paths so
+# omit any directory for the default case.
+# GDB_PARALLEL is written as "yes" for the default case in Makefile.in to mark
+# its special handling.
+
+proc make_gdb_parallel_path { args } {
+ global GDB_PARALLEL objdir
+ set joiner [list "file" "join" $objdir]
+ if { $GDB_PARALLEL != "yes" } {
+ lappend joiner $GDB_PARALLEL
+ }
+ set joiner [concat $joiner $args]
+ return [eval $joiner]
+}
+
# Turn BASENAME into a full file name in the standard output
# directory. It is ok if BASENAME is the empty string; in this case
# the directory is returned.
global objdir subdir gdb_test_file_name GDB_PARALLEL
if {[info exists GDB_PARALLEL]} {
- set dir [file join $objdir outputs $subdir $gdb_test_file_name]
+ set dir [make_gdb_parallel_path outputs $subdir $gdb_test_file_name]
file mkdir $dir
return [file join $dir $basename]
} else {
global objdir GDB_PARALLEL
if {[info exists GDB_PARALLEL]} {
- return [file join $objdir temp $basename]
+ return [make_gdb_parallel_path temp $basename]
} else {
return $basename
}
# if the banned variables and procedures are already traced.
set banned_traced 0
-proc gdb_init { args } {
+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 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
set gdbserver_reconnect_p 1
unset gdbserver_reconnect_p
- return [eval default_gdb_init $args]
+ return [default_gdb_init $test_file_name]
}
proc gdb_finish { } {
+ global gdbserver_reconnect_p
+ global gdb_prompt
global cleanfiles
# Exit first, so that the files are no longer in use.
global gdb_prompt
global srcdir
+ set xml_file [gdb_remote_download host "${srcdir}/gdb.xml/trivial.xml"]
+
gdb_start
set xml_missing 0
- gdb_test_multiple "set tdesc filename ${srcdir}/gdb.xml/trivial.xml" "" {
+ gdb_test_multiple "set tdesc filename $xml_file" "" {
-re ".*XML support was disabled at compile time.*$gdb_prompt $" {
set xml_missing 1
}
return $xml_missing
}
+# Return true if argv[0] is available.
+
+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 {
+ int main (int argc, char **argv) {
+ return 0;
+ }
+ }
+
+ gdb_compile $src $exe executable {debug}
+
+ # Helper proc.
+ proc gdb_has_argv0_1 { exe } {
+ global srcdir subdir
+ global gdb_prompt hex
+
+ gdb_exit
+ gdb_start
+ gdb_reinitialize_dir $srcdir/$subdir
+ gdb_load "$exe"
+
+ # Set breakpoint on main.
+ gdb_test_multiple "break main" "break main" {
+ -re "Breakpoint.*${gdb_prompt} $" {
+ }
+ -re "${gdb_prompt} $" {
+ return 0
+ }
+ }
+
+ # Run to main.
+ gdb_run_cmd
+ gdb_test_multiple "" "run to main" {
+ -re "Breakpoint.*${gdb_prompt} $" {
+ }
+ -re "${gdb_prompt} $" {
+ return 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
+ }
+ -re "${gdb_prompt} $" {
+ return 0
+ }
+ }
+ }
+ -re "${gdb_prompt} $" {
+ return 0
+ }
+ }
+ return 0
+ }
+
+ set result [gdb_has_argv0_1 $exe]
+
+ gdb_exit
+ file delete $src
+ file delete $exe
+
+ if { !$result
+ && ([istarget *-*-linux*]
+ || [istarget *-*-freebsd*] || [istarget *-*-kfreebsd*]
+ || [istarget *-*-netbsd*] || [istarget *-*-knetbsd*]
+ || [istarget *-*-openbsd*]
+ || [istarget *-*-darwin*]
+ || [istarget *-*-solaris*]
+ || [istarget *-*-aix*]
+ || [istarget *-*-gnu*]
+ || [istarget *-*-cygwin*] || [istarget *-*-mingw32*]
+ || [istarget *-*-*djgpp*] || [istarget *-*-go32*]
+ || [istarget *-wince-pe] || [istarget *-*-mingw32ce*]
+ || [istarget *-*-symbianelf*]
+ || [istarget *-*-osf*]
+ || [istarget *-*-hpux*]
+ || [istarget *-*-dicos*]
+ || [istarget *-*-nto*]
+ || [istarget *-*-*vms*]
+ || [istarget *-*-lynx*178]) } {
+ fail "argv\[0\] should be available on this target"
+ }
+
+ return $result
+}
+
# Note: the procedure gdb_gnu_strip_debug will produce an executable called
# ${binfile}.dbglnk, which is just like the executable ($binfile) but without
# the debuginfo. Instead $binfile has a .gnu_debuglink section which contains
# foo.debug --> foo's debug info
# foo --> like foo, but with a new .gnu_debuglink section pointing to foo.debug.
+# Fetch the build id from the file.
+# Returns "" if there is none.
+
+proc get_build_id { filename } {
+ if { ([istarget "*-*-mingw*"]
+ || [istarget *-*-cygwin*]) } {
+ set objdump_program [gdb_find_objdump]
+ set result [catch {set data [exec $objdump_program -p $filename | grep signature | cut "-d " -f4]} output]
+ verbose "result is $result"
+ verbose "output is $output"
+ if {$result == 1} {
+ return ""
+ }
+ return $data
+ } else {
+ set tmp [standard_output_file "${filename}-tmp"]
+ set objcopy_program [gdb_find_objcopy]
+ set result [catch "exec $objcopy_program -j .note.gnu.build-id -O binary $filename $tmp" output]
+ verbose "result is $result"
+ verbose "output is $output"
+ if {$result == 1} {
+ return ""
+ }
+ set fi [open $tmp]
+ fconfigure $fi -translation binary
+ # Skip the NOTE header.
+ read $fi 16
+ set data [read $fi]
+ close $fi
+ file delete $tmp
+ if ![string compare $data ""] then {
+ return ""
+ }
+ # Convert it to hex.
+ binary scan $data H* data
+ return $data
+ }
+}
+
# Return the build-id hex string (usually 160 bits as 40 hex characters)
# converted to the form: .build-id/ab/cdef1234...89.debug
# Return "" if no build-id found.
-proc build_id_debug_filename_get { exec } {
- set tmp [standard_output_file "${exec}-tmp"]
- set objcopy_program [gdb_find_objcopy]
-
- set result [catch "exec $objcopy_program -j .note.gnu.build-id -O binary $exec $tmp" output]
- verbose "result is $result"
- verbose "output is $output"
- if {$result == 1} {
- return ""
- }
- set fi [open $tmp]
- fconfigure $fi -translation binary
- # Skip the NOTE header.
- read $fi 16
- set data [read $fi]
- close $fi
- file delete $tmp
- if ![string compare $data ""] then {
+proc build_id_debug_filename_get { filename } {
+ set data [get_build_id $filename]
+ if { $data == "" } {
return ""
}
- # Convert it to hex.
- binary scan $data H* data
regsub {^..} $data {\0/} data
return ".build-id/${data}.debug"
}
# are regular expressions that should match the beginning of output,
# before the list of commands in that class. The presence of
# command list and standard epilogue will be tested automatically.
+# Notice that the '[' and ']' characters don't need to be escaped for strings
+# wrapped in {} braces.
proc test_class_help { command_class expected_initial_lines args } {
set l_stock_body {
- "List of commands\:.*\[\r\n\]+"
- "Type \"help\" followed by command name for full documentation\.\[\r\n\]+"
- "Type \"apropos word\" to search for commands related to \"word\"\.[\r\n\]+"
+ "List of commands\:.*[\r\n]+"
+ "Type \"help\" followed by command name for full documentation\.[\r\n]+"
+ "Type \"apropos word\" to search for commands related to \"word\"\.[\r\n]+"
"Command name abbreviations are allowed if unambiguous\."
}
set l_entire_body [concat $expected_initial_lines $l_stock_body]
if [string match gdb_compile_shlib* $func] {
set sources_path {}
foreach {s local_options} $args {
- lappend sources_path "${srcdir}/${subdir}/${s}"
+ if { [regexp "^/" "$s"] } then {
+ lappend sources_path "$s"
+ } else {
+ lappend sources_path "$srcdir/$subdir/$s"
+ }
}
set ret [$func $sources_path "${binfile}" $options]
} else {
set objects {}
set i 0
foreach {s local_options} $args {
- if { [gdb_compile "${srcdir}/${subdir}/${s}" "${binfile}${i}.o" object $local_options] != "" } {
+ if { ! [regexp "^/" "$s"] } then {
+ set s "$srcdir/$subdir/$s"
+ }
+ if { [gdb_compile "${s}" "${binfile}${i}.o" object $local_options] != "" } {
untested $testname
return -1
}
return [eval build_executable_from_specs $arglist]
}
-# Starts fresh GDB binary and loads EXECUTABLE into GDB. EXECUTABLE is
-# the basename of the binary.
-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
- 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 [get_integer_valueof "sizeof (${type})" $default]
}
+proc get_target_charset { } {
+ global gdb_prompt
+
+ gdb_test_multiple "show target-charset" "" {
+ -re "The target character set is \"auto; currently (\[^\"\]*)\".*$gdb_prompt $" {
+ return $expect_out(1,string)
+ }
+ -re "The target character set is \"(\[^\"\]*)\".*$gdb_prompt $" {
+ return $expect_out(1,string)
+ }
+ }
+
+ # Pick a reasonable default.
+ warning "Unable to read target-charset."
+ return "UTF-8"
+}
+
# Get the current value for remotetimeout and return it.
proc get_remotetimeout { } {
global gdb_prompt
}
}
+# 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
+# will return "ls".
+
+proc relative_filename {root full} {
+ set root_split [file split $root]
+ set full_split [file split $full]
+
+ set len [llength $root_split]
+
+ if {[eval file join $root_split]
+ != [eval file join [lrange $full_split 0 [expr {$len - 1}]]]} {
+ error "$full not a subdir of $root"
+ }
+
+ return [eval file join [lrange $full_split $len end]]
+}
+
# Log gdb command line and script if requested.
if {[info exists TRANSCRIPT]} {
rename send_gdb real_send_gdb
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]
}
}
# TODO: find out automatically if the target needs this.
proc gdb_target_symbol_prefix_flags {} {
- if { [istarget "*-*-cygwin*"] || [istarget "i?86-*-mingw*"]
+ if { [istarget "i?86-*-cygwin*"] || [istarget "i?86-*-mingw*"]
|| [istarget "*-*-msdosdjgpp*"] || [istarget "*-*-go32*"] } {
return "additional_flags=-DSYMBOL_PREFIX=\"_\""
} else {
pass $test
return 0
} else {
+ verbose -log "run_on_host failed: $output"
fail $test
return -1
}
return [regexp -- "-gsplit-dwarf" $debug_flags]
}
+# Search the caller's ARGS list and set variables according to the list of
+# valid options described by ARGSET.
+#
+# The first member of each one- or two-element list in ARGSET defines the
+# name of a variable that will be added to the caller's scope.
+#
+# If only one element is given to describe an option, it the value is
+# 0 if the option is not present in (the caller's) ARGS or 1 if
+# it is.
+#
+# If two elements are given, the second element is the default value of
+# the variable. This is then overwritten if the option exists in ARGS.
+#
+# Any parse_args elements in (the caller's) ARGS will be removed, leaving
+# any optional components.
+
+# Example:
+# proc myproc {foo args} {
+# parse_args {{bar} {baz "abc"} {qux}}
+# # ...
+# }
+# myproc ABC -bar -baz DEF peanut butter
+# will define the following variables in myproc:
+# foo (=ABC), bar (=1), baz (=DEF), and qux (=0)
+# args will be the list {peanut butter}
+
+proc parse_args { argset } {
+ upvar args args
+
+ foreach argument $argset {
+ if {[llength $argument] == 1} {
+ # No default specified, so we assume that we should set
+ # the value to 1 if the arg is present and 0 if it's not.
+ # It is assumed that no value is given with the argument.
+ set result [lsearch -exact $args "-$argument"]
+ if {$result != -1} then {
+ uplevel 1 [list set $argument 1]
+ set args [lreplace $args $result $result]
+ } else {
+ uplevel 1 [list set $argument 0]
+ }
+ } elseif {[llength $argument] == 2} {
+ # There are two items in the argument. The second is a
+ # default value to use if the item is not present.
+ # Otherwise, the variable is set to whatever is provided
+ # after the item in the args.
+ set arg [lindex $argument 0]
+ set result [lsearch -exact $args "-[lindex $arg 0]"]
+ if {$result != -1} then {
+ uplevel 1 [list set $arg [lindex $args [expr $result+1]]]
+ set args [lreplace $args $result [expr $result+1]]
+ } else {
+ uplevel 1 [list set $arg [lindex $argument 1]]
+ }
+ } else {
+ error "Badly formatted argument \"$argument\" in argument set"
+ }
+ }
+
+ # The remaining args should be checked to see that they match the
+ # number of items expected to be passed into the procedure...
+}
+
+# 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 "[string_to_regexp ${command}]\[\r\n\]+${prefix}(.*)\[\r\n\]+$gdb_prompt $" {
+ set output_string $expect_out(1,string)
+ }
+ }
+ return $output_string
+}
+
+# A convenience function that joins all the arguments together, with a
+# regexp that matches exactly one end of line in between each argument.
+# This function is ideal to write the expected output of a GDB command
+# that generates more than a couple of lines, as this allows us to write
+# each line as a separate string, which is easier to read by a human
+# being.
+
+proc multi_line { args } {
+ return [join $args "\r\n"]
+}
+
# Always load compatibility stuff.
load_lib future.exp
projects / deliverable / binutils-gdb.git / blobdiff