-# Copyright 1992-2014 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
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
}
# 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"
}
}
# }
# }
#
+# 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 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 } {
-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."
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 != "" } {
perror "Spawning $GDB failed."
return 1
}
- set gdb_spawn_id -1
+
+ set gdb_spawn_id $res
return 0
}
# Default gdb_start procedure.
proc default_gdb_start { } {
- global gdb_prompt
+ global gdb_prompt pagination_prompt
global gdb_spawn_id
+ global inferior_spawn_id
if [info exists gdb_spawn_id] {
return 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.
- 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
+ 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
+ }
}
}
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 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
}
}
+# 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 {
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.
}
if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
- || [istarget "i\[34567\]86-*-linux*"] } {
+ || [istarget "i\[34567\]86-*-linux*"]
+ || [istarget "aarch64*-*-linux*"]
+ || [istarget "powerpc*-*-linux*"] } {
return 1
}
}
if { [istarget "arm*-*-linux*"] || [istarget "x86_64-*-linux*"]
- || [istarget "i\[34567\]86-*-linux*"] } {
+ || [istarget "i\[34567\]86-*-linux*"]
+ || [istarget "aarch64*-*-linux*"]
+ || [istarget "powerpc*-*-linux*"] } {
return 1
}
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 {} {
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
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.
|| [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
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 ""
+ }
+}
+
#
#
# A timeout argument takes precedence, otherwise of all the timeouts
# select the largest.
- upvar #0 timeout gtimeout
- upvar timeout timeout
if [info exists atimeout] {
set tmt $atimeout
} else {
- 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
- }
+ set tmt [get_largest_timeout]
}
global suppress_flag
set saved_gdbflags $GDBFLAGS
+ if {$GDBFLAGS != ""} {
+ append GDBFLAGS " "
+ }
append GDBFLAGS $cmdline_flags
set res [gdb_spawn]
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 TCL's exec to get the inferior's pid.
+ 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
+}
+
# 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.
proc spawn_wait_for_attach { executable_list } {
set pid_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 {
lappend pid_list [eval exec $executable &]
}
#
# 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 } {
if { $arg != "" } {
return [gdb_file_cmd $arg]
}
+ return 0
}
# gdb_reload -- load a file into the target. Called before "running",
global gdb_prompt
global cleanfiles
- # Give persistent gdbserver a chance to terminate before GDB is killed.
- if {[info exists gdbserver_reconnect_p] && $gdbserver_reconnect_p
- && [info exists gdb_spawn_id]} {
- send_gdb "kill\n";
- gdb_expect 10 {
- -re "y or n" {
- send_gdb "y\n";
- exp_continue;
- }
- -re "$gdb_prompt $" {
- }
- }
- }
-
# Exit first, so that the files are no longer in use.
gdb_exit
# Returns "" if there is none.
proc get_build_id { filename } {
- 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 ""
+ 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
}
- # Convert it to hex.
- binary scan $data H* data
- return $data
}
# Return the build-id hex string (usually 160 bits as 40 hex characters)
# 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]
# 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 } {
global srcdir
global subdir
gdb_exit
gdb_start
gdb_reinitialize_dir $srcdir/$subdir
- gdb_load ${binfile}
+ return [gdb_load ${binfile}]
}
# Prepares for testing by calling build_executable_full, then
# 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 {
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