From: Tom Tromey Date: Tue, 7 May 2013 18:06:16 +0000 (+0000) Subject: * lib/selftest-support.exp: New file. X-Git-Url: https://git.libre-soc.org/?a=commitdiff_plain;h=c95aea6b79230dfbbf3b4d96a373fd81cdff7666;p=binutils-gdb.git * lib/selftest-support.exp: New file. * gdb.gdb/complaints.exp: Load selftest-support.exp. Use do_self_tests. (setup_test, find_gdb): Remove. * gdb.gdb/observer.exp: Load selftest-support.exp. Use do_self_tests. (setup_test, find_gdb): Remove. (test_observer): Don't call setup_test. Remove argument. * gdb.gdb/selftest.exp: Load selftest-support.exp. (find_gdb): Remove. * gdb.gdb/complaints.exp: Load selftest-support.exp. Use do_self_tests. (setup_test, find_gdb): Remove. (test_with_self): Don't call setup_test. Remove argument. --- diff --git a/gdb/testsuite/ChangeLog b/gdb/testsuite/ChangeLog index eccae7e4b34..5ca6bffb13a 100644 --- a/gdb/testsuite/ChangeLog +++ b/gdb/testsuite/ChangeLog @@ -1,3 +1,20 @@ +2013-05-07 Tom Tromey + + * lib/selftest-support.exp: New file. + * gdb.gdb/complaints.exp: Load selftest-support.exp. Use + do_self_tests. + (setup_test, find_gdb): Remove. + * gdb.gdb/observer.exp: Load selftest-support.exp. Use + do_self_tests. + (setup_test, find_gdb): Remove. + (test_observer): Don't call setup_test. Remove argument. + * gdb.gdb/selftest.exp: Load selftest-support.exp. + (find_gdb): Remove. + * gdb.gdb/complaints.exp: Load selftest-support.exp. Use + do_self_tests. + (setup_test, find_gdb): Remove. + (test_with_self): Don't call setup_test. Remove argument. + 2013-05-07 Andreas Arnez * gdb.arch/system-gcore.exp: Remove. diff --git a/gdb/testsuite/gdb.gdb/complaints.exp b/gdb/testsuite/gdb.gdb/complaints.exp index f2987255455..932dfd58367 100644 --- a/gdb/testsuite/gdb.gdb/complaints.exp +++ b/gdb/testsuite/gdb.gdb/complaints.exp @@ -17,6 +17,7 @@ # derived from xfullpath.exp (written by Joel Brobecker), derived from # selftest.exp (written by Rob Savoye). +load_lib selftest-support.exp # are we on a target board if { [is_remote target] || ![isnative] } then { @@ -28,79 +29,6 @@ if [target_info exists gdb,noinferiorio] { return } -proc setup_test { executable } { - global gdb_prompt - global timeout - global INTERNAL_GDBFLAGS - - # load yourself into the debugger - # This can take a relatively long time, particularly for testing where - # the executable is being accessed over a network, or where gdb does not - # support partial symbols for a particular target and has to load the - # entire symbol table. Set the timeout to 10 minutes, which should be - # adequate for most environments (it *has* timed out with 5 min on a - # SPARCstation SLC under moderate load, so this isn't unreasonable). - # After gdb is started, set the timeout to 30 seconds for the duration - # of this test, and then back to the original value. - - set oldtimeout $timeout - set timeout 600 - verbose "Timeout is now $timeout seconds" 2 - - global gdb_file_cmd_debug_info - set gdb_file_cmd_debug_info "unset" - - set result [gdb_load $executable] - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - if { $result != 0 } then { - return -1 - } - - if { $gdb_file_cmd_debug_info != "debug" } then { - untested "No debug information, skipping testcase." - return -1 - } - - # Set a breakpoint at main - gdb_test "break captured_command_loop" \ - "Breakpoint.*at.* file.*, line.*" \ - "breakpoint in captured_command_loop" - - # run yourself - # It may take a very long time for the inferior gdb to start (lynx), - # so we bump it back up for the duration of this command. - set timeout 600 - - set description "run until breakpoint at captured_command_loop" - gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" { - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.* at .*main.c:.*$gdb_prompt $" { - pass "$description" - } - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_command_loop .data.*$gdb_prompt $" { - xfail "$description (line numbers scrambled?)" - } - -re "vfork: No more processes.*$gdb_prompt $" { - fail "$description (out of virtual memory)" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - -re ".*$gdb_prompt $" { - fail "$description" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - } - - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - return 0 -} - proc test_initial_complaints { } { global gdb_prompt @@ -221,51 +149,9 @@ proc test_empty_complaints { } { return 0 } -# Find a pathname to a file that we would execute if the shell was asked -# to run $arg using the current PATH. - -proc find_gdb { arg } { - - # If the arg directly specifies an existing executable file, then - # simply use it. - - if [file executable $arg] then { - return $arg - } - - set result [which $arg] - if [string match "/" [ string range $result 0 0 ]] then { - return $result - } - - # If everything fails, just return the unqualified pathname as default - # and hope for best. - - return $arg -} - -# Run the test with self. -# Copy the file executable file in case this OS doesn't like to edit its own -# text space. - -set GDB_FULLPATH [find_gdb $GDB] - -# Remove any old copy lying around. -remote_file host delete x$tool - -gdb_start - -set file [remote_download host $GDB_FULLPATH x$tool] - -set setup_result [setup_test $file ] -if {$setup_result <0} then { - return -1 +do_self_tests captured_command_loop { + test_initial_complaints + test_serial_complaints + test_short_complaints + test_empty_complaints } - -test_initial_complaints -test_serial_complaints -test_short_complaints -test_empty_complaints - -gdb_exit; -catch "remote_file host delete $file"; diff --git a/gdb/testsuite/gdb.gdb/observer.exp b/gdb/testsuite/gdb.gdb/observer.exp index 9397146d071..32030d88da3 100644 --- a/gdb/testsuite/gdb.gdb/observer.exp +++ b/gdb/testsuite/gdb.gdb/observer.exp @@ -16,85 +16,13 @@ # This file was written by Joel Brobecker (brobecker@gnat.com), derived # from xfullpath.exp. +load_lib selftest-support.exp # are we on a target board if { [is_remote target] || ![isnative] } then { return } -proc setup_test { executable } { - global gdb_prompt - global timeout - global INTERNAL_GDBFLAGS - - # load yourself into the debugger - # This can take a relatively long time, particularly for testing where - # the executable is being accessed over a network, or where gdb does not - # support partial symbols for a particular target and has to load the - # entire symbol table. Set the timeout to 10 minutes, which should be - # adequate for most environments (it *has* timed out with 5 min on a - # SPARCstation SLC under moderate load, so this isn't unreasonable). - # After gdb is started, set the timeout to 30 seconds for the duration - # of this test, and then back to the original value. - - set oldtimeout $timeout - set timeout 600 - verbose "Timeout is now $timeout seconds" 2 - - global gdb_file_cmd_debug_info - set gdb_file_cmd_debug_info "unset" - - set result [gdb_load $executable] - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - if { $result != 0 } then { - return -1 - } - - if { $gdb_file_cmd_debug_info != "debug" } then { - untested "No debug information, skipping testcase." - return -1 - } - - # Set a breakpoint at main - gdb_test "break captured_main" \ - "Breakpoint.*at.* file.*, line.*" \ - "breakpoint in captured_main" - - # run yourself - # It may take a very long time for the inferior gdb to start (lynx), - # so we bump it back up for the duration of this command. - set timeout 600 - - set description "run until breakpoint at captured_main" - gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" { - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" { - pass "$description" - } - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" { - xfail "$description (line numbers scrambled?)" - } - -re "vfork: No more processes.*$gdb_prompt $" { - fail "$description (out of virtual memory)" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - -re ".*$gdb_prompt $" { - fail "$description" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - } - - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - return 0 -} - proc attach_first_observer { message } { gdb_test_no_output "set \$first_obs = observer_attach_test_notification (&observer_test_first_notification_function)" \ "$message; attach first observer" @@ -160,13 +88,7 @@ proc test_notifications { first second third message args } { check_counters $first $second $third $message } -proc test_observer { executable } { - - set setup_result [setup_test $executable] - if {$setup_result <0} then { - return -1 - } - +proc test_observer {} { # First, try sending a notification without any observer attached. test_notifications 0 0 0 "no observer attached" @@ -223,45 +145,4 @@ proc test_observer { executable } { return 0 } -# Find a pathname to a file that we would execute if the shell was asked -# to run $arg using the current PATH. - -proc find_gdb { arg } { - - # If the arg directly specifies an existing executable file, then - # simply use it. - - if [file executable $arg] then { - return $arg - } - - set result [which $arg] - if [string match "/" [ string range $result 0 0 ]] then { - return $result - } - - # If everything fails, just return the unqualified pathname as default - # and hope for best. - - return $arg -} - -# Run the test with self. -# Copy the file executable file in case this OS doesn't like to edit its own -# text space. - -set GDB_FULLPATH [find_gdb $GDB] - -# Remove any old copy lying around. -remote_file host delete x$tool - -gdb_start -set file [remote_download host $GDB_FULLPATH x$tool] -set result [test_observer $file]; -gdb_exit; -catch "remote_file host delete $file"; - -if {$result <0} then { - warning "Couldn't test self" - return -1 -} +do_self_tests captured_main test_observer diff --git a/gdb/testsuite/gdb.gdb/selftest.exp b/gdb/testsuite/gdb.gdb/selftest.exp index 5430aeec9c1..8faf8c99723 100644 --- a/gdb/testsuite/gdb.gdb/selftest.exp +++ b/gdb/testsuite/gdb.gdb/selftest.exp @@ -15,6 +15,7 @@ # This file was written by Rob Savoye. (rob@cygnus.com) +load_lib selftest-support.exp # are we on a target board if { [is_remote target] || ![isnative] } then { @@ -472,29 +473,6 @@ proc test_with_self { executable } { return 0 } -# Find a pathname to a file that we would execute if the shell was asked -# to run $arg using the current PATH. - -proc find_gdb { arg } { - - # If the arg directly specifies an existing executable file, then - # simply use it. - - if [file executable $arg] then { - return $arg - } - - set result [which $arg] - if [string match "/" [ string range $result 0 0 ]] then { - return $result - } - - # If everything fails, just return the unqualified pathname as default - # and hope for best. - - return $arg -} - # Run the test with self. # Copy the file executable file in case this OS doesn't like to edit its own # text space. diff --git a/gdb/testsuite/gdb.gdb/xfullpath.exp b/gdb/testsuite/gdb.gdb/xfullpath.exp index 9516a4ff993..5bc01c6f822 100644 --- a/gdb/testsuite/gdb.gdb/xfullpath.exp +++ b/gdb/testsuite/gdb.gdb/xfullpath.exp @@ -16,92 +16,14 @@ # This file was written by Joel Brobecker. (brobecker@gnat.com), derived # from selftest.exp, written by Rob Savoye. +load_lib selftest-support.exp # are we on a target board if { [is_remote target] || ![isnative] } then { return } -proc setup_test { executable } { - global gdb_prompt - global timeout - global INTERNAL_GDBFLAGS - - # load yourself into the debugger - # This can take a relatively long time, particularly for testing where - # the executable is being accessed over a network, or where gdb does not - # support partial symbols for a particular target and has to load the - # entire symbol table. Set the timeout to 10 minutes, which should be - # adequate for most environments (it *has* timed out with 5 min on a - # SPARCstation SLC under moderate load, so this isn't unreasonable). - # After gdb is started, set the timeout to 30 seconds for the duration - # of this test, and then back to the original value. - - set oldtimeout $timeout - set timeout 600 - verbose "Timeout is now $timeout seconds" 2 - - global gdb_file_cmd_debug_info - set gdb_file_cmd_debug_info "unset" - - set result [gdb_load $executable] - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - if { $result != 0 } then { - return -1 - } - - if { $gdb_file_cmd_debug_info != "debug" } then { - untested "No debug information, skipping testcase." - return -1 - } - - # Set a breakpoint at main - gdb_test "break captured_main" \ - "Breakpoint.*at.* file.*, line.*" \ - "breakpoint in captured_main" - - # run yourself - # It may take a very long time for the inferior gdb to start (lynx), - # so we bump it back up for the duration of this command. - set timeout 600 - - set description "run until breakpoint at captured_main" - gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" { - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" { - pass "$description" - } - -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" { - xfail "$description (line numbers scrambled?)" - } - -re "vfork: No more processes.*$gdb_prompt $" { - fail "$description (out of virtual memory)" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - -re ".*$gdb_prompt $" { - fail "$description" - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - return -1 - } - } - - set timeout $oldtimeout - verbose "Timeout is now $timeout seconds" 2 - - return 0 -} - -proc test_with_self { executable } { - - set setup_result [setup_test $executable] - if {$setup_result <0} then { - return -1 - } - +proc test_with_self {} { # A file which contains a directory prefix gdb_test "print gdb_realpath (\"./xfullpath.exp\")" \ ".\[0-9\]+ =.*\".*/xfullpath.exp\"" \ @@ -140,45 +62,4 @@ proc test_with_self { executable } { return 0 } -# Find a pathname to a file that we would execute if the shell was asked -# to run $arg using the current PATH. - -proc find_gdb { arg } { - - # If the arg directly specifies an existing executable file, then - # simply use it. - - if [file executable $arg] then { - return $arg - } - - set result [which $arg] - if [string match "/" [ string range $result 0 0 ]] then { - return $result - } - - # If everything fails, just return the unqualified pathname as default - # and hope for best. - - return $arg -} - -# Run the test with self. -# Copy the file executable file in case this OS doesn't like to edit its own -# text space. - -set GDB_FULLPATH [find_gdb $GDB] - -# Remove any old copy lying around. -remote_file host delete x$tool - -gdb_start -set file [remote_download host $GDB_FULLPATH x$tool] -set result [test_with_self $file]; -gdb_exit; -catch "remote_file host delete $file"; - -if {$result <0} then { - warning "Couldn't test self" - return -1 -} +do_self_tests captured_main test_with_self diff --git a/gdb/testsuite/lib/selftest-support.exp b/gdb/testsuite/lib/selftest-support.exp new file mode 100644 index 00000000000..c3758499dc8 --- /dev/null +++ b/gdb/testsuite/lib/selftest-support.exp @@ -0,0 +1,144 @@ +# Copyright 2003-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 +# the Free Software Foundation; either version 3 of the License, or +# (at your option) any later version. +# +# This program is distributed in the hope that it will be useful, +# but WITHOUT ANY WARRANTY; without even the implied warranty of +# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +# GNU General Public License for more details. +# +# You should have received a copy of the GNU General Public License +# along with this program. If not, see . + +# Find a pathname to a file that we would execute if the shell was asked +# to run $arg using the current PATH. + +proc find_gdb { arg } { + + # If the arg directly specifies an existing executable file, then + # simply use it. + + if [file executable $arg] then { + return $arg + } + + set result [which $arg] + if [string match "/" [ string range $result 0 0 ]] then { + return $result + } + + # If everything fails, just return the unqualified pathname as default + # and hope for best. + + return $arg +} + +# A helper proc that sets up for self-testing. +# EXECUTABLE is the gdb to use. +# FUNCTION is the function to break in, either captured_main +# or captured_command_loop. + +proc selftest_setup { executable function } { + global gdb_prompt + global timeout + global INTERNAL_GDBFLAGS + + # load yourself into the debugger + # This can take a relatively long time, particularly for testing where + # the executable is being accessed over a network, or where gdb does not + # support partial symbols for a particular target and has to load the + # entire symbol table. Set the timeout to 10 minutes, which should be + # adequate for most environments (it *has* timed out with 5 min on a + # SPARCstation SLC under moderate load, so this isn't unreasonable). + # After gdb is started, set the timeout to 30 seconds for the duration + # of this test, and then back to the original value. + + set oldtimeout $timeout + set timeout 600 + verbose "Timeout is now $timeout seconds" 2 + + global gdb_file_cmd_debug_info + set gdb_file_cmd_debug_info "unset" + + set result [gdb_load $executable] + set timeout $oldtimeout + verbose "Timeout is now $timeout seconds" 2 + + if { $result != 0 } then { + return -1 + } + + if { $gdb_file_cmd_debug_info != "debug" } then { + untested "No debug information, skipping testcase." + return -1 + } + + # Set a breakpoint at main + gdb_test "break $function" \ + "Breakpoint.*at.* file.*, line.*" \ + "breakpoint in $function" + + # run yourself + # It may take a very long time for the inferior gdb to start (lynx), + # so we bump it back up for the duration of this command. + set timeout 600 + + set description "run until breakpoint at $function" + gdb_test_multiple "run $INTERNAL_GDBFLAGS" "$description" { + -re "Starting program.*Breakpoint \[0-9\]+,.*$function .data.* at .*main.c:.*$gdb_prompt $" { + pass "$description" + } + -re "Starting program.*Breakpoint \[0-9\]+,.*$function .data.*$gdb_prompt $" { + xfail "$description (line numbers scrambled?)" + } + -re "vfork: No more processes.*$gdb_prompt $" { + fail "$description (out of virtual memory)" + set timeout $oldtimeout + verbose "Timeout is now $timeout seconds" 2 + return -1 + } + -re ".*$gdb_prompt $" { + fail "$description" + set timeout $oldtimeout + verbose "Timeout is now $timeout seconds" 2 + return -1 + } + } + + set timeout $oldtimeout + verbose "Timeout is now $timeout seconds" 2 + + return 0 +} + +# A simple way to run some self-tests. + +proc do_self_tests {function body} { + global GDB tool + + # Run the test with self. Copy the file executable file in case + # this OS doesn't like to edit its own text space. + + set GDB_FULLPATH [find_gdb $GDB] + + # Remove any old copy lying around. + remote_file host delete x$tool + + gdb_start + set file [remote_download host $GDB_FULLPATH x$tool] + + set result [selftest_setup $file $function] + if {$result == 0} then { + set result [uplevel $body] + } + + gdb_exit + catch "remote_file host delete $file" + + if {$result < 0} then { + warning "Couldn't test self" + } +}