-# Copyright 1992-2005, 2007-2012 Free Software Foundation, Inc.
+# Copyright 1992-2013 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
}
proc gdb_version { } {
- return [default_gdb_version];
+ return [default_gdb_version]
}
#
# gdb_unload -- unload a file if one is loaded
+# Return 0 on success, -1 on error.
#
proc gdb_unload {} {
return -1
}
}
+ return 0
}
# Many of the tests depend on setting breakpoints at various places and
-re "$gdb_prompt $" { }
default {
perror "gdb_init_command for target failed";
- return -1;
+ return -1
}
}
}
if { $print_pass } {
pass $test_name
}
- return 1;
+ return 1
}
# Set breakpoint at function and run gdb until it breaks there.
# elements, and we don't want Tcl to move the remaining elements after
# the first to $args. That is why $function is wrapped in {}.
if ![eval gdb_breakpoint {$function} $args] {
- return 0;
+ return 0
}
gdb_run_cmd
perror "Couldn't send $command to GDB.";
}
fail "$message";
- return $result;
+ return $result
}
# since we're checking if each line of the multi-line
# command are 'accepted' by GDB here,
perror "Couldn't send $command to GDB.";
}
fail "$message";
- return $result;
+ return $result
}
}
}
global gdb_prompt
if [is_remote host] {
- return "";
+ return ""
}
send_gdb "dir\n"
gdb_expect 60 {
#
# debug file was loaded successfully and has debug information
# nodebug file was loaded successfully and has no debug information
+# lzma file was loaded, .gnu_debugdata found, but no LZMA support
+# compiled in
# fail file was not loaded
#
# I tried returning this information as part of the return value,
send_gdb "file $arg\n"
gdb_expect 120 {
+ -re "Reading symbols from.*LZMA support was disabled.*done.*$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 $" {
verbose "\t\tLoaded $arg into $GDB with no debugging symbols"
set gdb_file_cmd_debug_info "nodebug"
verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS"
if [info exists gdb_spawn_id] {
- return 0;
+ return 0
}
if ![is_remote host] {
set res [remote_spawn host "$GDB $INTERNAL_GDBFLAGS $GDBFLAGS [host_info gdb_opts]"];
if { $res < 0 || $res == "" } {
perror "Spawning $GDB failed."
- return 1;
+ return 1
}
gdb_expect 360 {
-re "\[\r\n\]$gdb_prompt $" {
warning "Couldn't set the width to 0."
}
}
- return 0;
+ return 0
}
# Examine the output of compilation to determine whether compilation
proc skip_python_tests {} {
global gdb_prompt
- gdb_test_multiple "python print 'test'" "verify python support" {
+ global gdb_py_is_py3k
+ global gdb_py_is_py24
+
+ gdb_test_multiple "python print ('test')" "verify python support" {
-re "not supported.*$gdb_prompt $" {
unsupported "Python support is disabled."
return 1
-re "$gdb_prompt $" {}
}
+ set gdb_py_is_py24 0
+ gdb_test_multiple "python print (sys.version_info\[0\])" "check if python 3" {
+ -re "3.*$gdb_prompt $" {
+ set gdb_py_is_py3k 1
+ }
+ -re ".*$gdb_prompt $" {
+ 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 $skip_vsx_tests_saved
}
+# Run a test on the target to see if it supports btrace hardware. Return 0 if so,
+# 1 if it does not. Based on 'check_vmx_hw_available' from the GCC testsuite.
+
+proc skip_btrace_tests {} {
+ global skip_btrace_tests_saved
+ global srcdir subdir gdb_prompt inferior_exited_re
+
+ # Use the cached value, if it exists.
+ set me "skip_btrace_tests"
+ if [info exists skip_btrace_tests_saved] {
+ verbose "$me: returning saved $skip_btrace_tests_saved" 2
+ return $skip_btrace_tests_saved
+ }
+
+ if { ![istarget "i?86-*-*"] && ![istarget "x86_64-*-*"] } {
+ verbose "$me: target does not support btrace, returning 1" 2
+ return [set skip_btrace_tests_saved 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_output_file btrace[pid].c]
+ set exe [standard_output_file btrace[pid].x]
+
+ set f [open $src "w"]
+ puts $f "int main(void) { return 0; }"
+ close $f
+
+ 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 [set skip_btrace_tests_saved 1]
+ }
+
+ # No error message, compilation succeeded so now run it via gdb.
+
+ clean_restart btrace[pid].x
+ if ![runto_main] {
+ file delete $src
+ return [set skip_btrace_tests_saved 1]
+ }
+ file delete $src
+ # In case of an unexpected output, we return 2 as a fail value.
+ set skip_btrace_tests_saved 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_saved 1
+ }
+ -re "Target does not support branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests_saved 1
+ }
+ -re "Could not enable branch tracing.*\r\n$gdb_prompt $" {
+ set skip_btrace_tests_saved 1
+ }
+ -re "^record btrace\r\n$gdb_prompt $" {
+ set skip_btrace_tests_saved 0
+ }
+ }
+ gdb_exit
+ remote_file build delete $exe
+
+ verbose "$me: returning $skip_btrace_tests_saved" 2
+ return $skip_btrace_tests_saved
+}
+
# Skip all the tests in the file if you are not on an hppa running
# hpux target.
uplevel \#0 { set false false }
}
- return 0;
+ return 0
}
proc test_compiler_info { {compiler ""} } {
clone_output "gdb compile failed, $result"
}
}
- return $result;
+ return $result
}
proc send_gdb { string } {
global suppress_flag;
if { $suppress_flag } {
- return "suppressed";
+ return "suppressed"
}
- return [remote_send host "$string"];
+ return [remote_send host "$string"]
}
#
proc gdb_continue { function } {
global decimal
- return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"];
+ return [gdb_test "continue" ".*Breakpoint $decimal, $function .*" "continue to $function"]
}
proc default_gdb_init { args } {
set gdbserver_reconnect_p 1
unset gdbserver_reconnect_p
- return [eval default_gdb_init $args];
+ return [eval default_gdb_init $args]
}
proc gdb_finish { } {
-re "Compiled with (.*) debugging format.\r\n.*$gdb_prompt $" {
set debug_format $expect_out(1,string)
verbose "debug format is $debug_format"
- return 1;
+ return 1
}
-re "No current source file.\r\n$gdb_prompt $" {
perror "get_debug_format used when no current source file"
- return 0;
+ return 0
}
-re "$gdb_prompt $" {
warning "couldn't check debug format (no valid response)."
- return 1;
+ return 1
}
timeout {
warning "couldn't check debug format (timeout)."
- return 1;
+ return 1
}
}
}
if {$ret} then {
setup_xfail "*-*-*"
}
- return $ret;
+ return $ret
}
# gdb_get_line_number TEXT [FILE]
proc gdb_skip_float_test { msg } {
if [target_info exists gdb,skip_float_tests] {
verbose "Skipping test '$msg': no float tests.";
- return 1;
+ return 1
}
- return 0;
+ return 0
}
# Print a message and return true if a test should be skipped
proc gdb_skip_stdio_test { msg } {
if [target_info exists gdb,noinferiorio] {
verbose "Skipping test '$msg': no inferior i/o.";
- return 1;
+ return 1
}
- return 0;
+ return 0
}
proc gdb_skip_bogus_test { msg } {
- return 0;
+ return 0
}
# Return true if a test should be skipped due to lack of XML support
# Convert it to hex.
binary scan $data H* data
regsub {^..} $data {\0/} data
- return ".build-id/${data}.debug";
+ return ".build-id/${data}.debug"
}
# Create stripped files for DEST, replacing it. If ARGS is passed, it is a
gdb_test_multiple "show remotetimeout" "" {
-re "Timeout limit to wait for target to respond is ($decimal).*$gdb_prompt $" {
- return $expect_out(1,string);
+ return $expect_out(1,string)
}
}