X-Git-Url: http://drtracing.org/?a=blobdiff_plain;f=gdb%2Ftestsuite%2Flib%2Fgdb.exp;h=0b4c67926df5f169a784bb10e8d30187da38baab;hb=4442ada7ba43cd543e6ceae6f4e81a5a189bbf0c;hp=1823e006c3f7c33500f271f28bc19d864c6a7910;hpb=1d41d75cb6f1e78eedf871801a351e8be761daff;p=deliverable%2Fbinutils-gdb.git diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 1823e006c3..0b4c67926d 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -1,6 +1,4 @@ -# Copyright 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, -# 2003, 2004, 2005, 2007, 2008, 2009, 2010, 2011 -# Free Software Foundation, Inc. +# Copyright 1992-2005, 2007-2012 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 @@ -54,10 +52,13 @@ if ![info exists GDBFLAGS] { } verbose "using GDBFLAGS = $GDBFLAGS" 2 +# Make the build data directory available to tests. +set BUILD_DATA_DIRECTORY "[pwd]/../data-directory" + # INTERNAL_GDBFLAGS contains flags that the testsuite requires. global INTERNAL_GDBFLAGS if ![info exists INTERNAL_GDBFLAGS] { - set INTERNAL_GDBFLAGS "-nw -nx -data-directory [pwd]/../data-directory" + set INTERNAL_GDBFLAGS "-nw -nx -data-directory $BUILD_DATA_DIRECTORY" } # The variable gdb_prompt is a regexp which matches the gdb prompt. @@ -197,7 +198,7 @@ proc delete_breakpoints {} { # that is the caller's responsibility. proc gdb_run_cmd {args} { - global gdb_prompt + global gdb_prompt use_gdb_stub if [target_info exists gdb_init_command] { send_gdb "[target_info gdb_init_command]\n"; @@ -210,7 +211,7 @@ proc gdb_run_cmd {args} { } } - if [target_info exists use_gdb_stub] { + if $use_gdb_stub { if [target_info exists gdb,do_reload_on_run] { if { [gdb_reload] != 0 } { return; @@ -268,13 +269,6 @@ proc gdb_run_cmd {args} { } } } - if [target_info exists gdb_stub] { - gdb_expect 60 { - -re "$gdb_prompt $" { - send_gdb "continue\n" - } - } - } return } @@ -306,7 +300,7 @@ proc gdb_run_cmd {args} { # that is the caller's responsibility. proc gdb_start_cmd {args} { - global gdb_prompt + global gdb_prompt use_gdb_stub if [target_info exists gdb_init_command] { send_gdb "[target_info gdb_init_command]\n"; @@ -314,12 +308,12 @@ proc gdb_start_cmd {args} { -re "$gdb_prompt $" { } default { perror "gdb_init_command for target failed"; - return; + return -1; } } } - if [target_info exists use_gdb_stub] { + if $use_gdb_stub { return -1 } @@ -456,26 +450,12 @@ proc runto { function args } { } # Ask gdb to run until we hit a breakpoint at main. -# The case where the target uses stubs has to be handled -# specially--if it uses stubs, assuming we hit -# breakpoint() and just step out of the function. # # N.B. This function deletes all existing breakpoints. # If you don't want that, use gdb_start_cmd. proc runto_main { } { - global gdb_prompt - global decimal - - if ![target_info exists gdb_stub] { - return [runto main] - } - - delete_breakpoints - - gdb_step_for_stub; - - return 1 + return [runto main] } ### Continue, and expect to hit a breakpoint. @@ -489,7 +469,7 @@ proc gdb_continue_to_breakpoint {name {location_pattern .*}} { send_gdb "continue\n" gdb_expect { - -re "Breakpoint .* (at|in) $location_pattern\r\n$gdb_prompt $" { + -re "(?:Breakpoint|Temporary breakpoint) .* (at|in) $location_pattern\r\n$gdb_prompt $" { pass $full_name } -re ".*$gdb_prompt $" { @@ -587,7 +567,7 @@ proc gdb_internal_error_resync {} { # ...", all being implicitly appended to that list. # proc gdb_test_multiple { command message user_code } { - global verbose + global verbose use_gdb_stub global gdb_prompt global GDB global inferior_exited_re @@ -606,6 +586,12 @@ proc gdb_test_multiple { command message user_code } { error "Invalid newline in \"$message\" test" } + if {$use_gdb_stub + && [regexp -nocase {^\s*(r|run|star|start|at|att|atta|attac|attach)\M} \ + $command]} { + error "gdbserver does not support $command without extended-remote" + } + # TCL/EXPECT WART ALERT # Expect does something very strange when it receives a single braced # argument. It splits it along word separators and performs substitutions. @@ -741,21 +727,21 @@ proc gdb_test_multiple { command message user_code } { } set code { - -re ".*A problem internal to GDB has been detected" { - fail "$message (GDB internal error)" - gdb_internal_error_resync - } - -re "\\*\\*\\* DOSEXIT code.*" { - if { $message != "" } { - fail "$message"; - } - gdb_suppress_entire_file "GDB died"; - set result -1; - } + -re ".*A problem internal to GDB has been detected" { + fail "$message (GDB internal error)" + gdb_internal_error_resync + } + -re "\\*\\*\\* DOSEXIT code.*" { + if { $message != "" } { + fail "$message"; + } + gdb_suppress_entire_file "GDB died"; + set result -1; + } } append code $processed_code append code { - -re "Ending remote debugging.*$gdb_prompt $" { + -re "Ending remote debugging.*$gdb_prompt $" { if ![isnative] then { warning "Can`t communicate to remote target." } @@ -763,17 +749,17 @@ proc gdb_test_multiple { command message user_code } { gdb_start set result -1 } - -re "Undefined\[a-z\]* command:.*$gdb_prompt $" { + -re "Undefined\[a-z\]* command:.*$gdb_prompt $" { perror "Undefined command \"$command\"." - fail "$message" + fail "$message" set result 1 } - -re "Ambiguous command.*$gdb_prompt $" { + -re "Ambiguous command.*$gdb_prompt $" { perror "\"$command\" is not a unique command name." - fail "$message" + fail "$message" set result 1 } - -re "$inferior_exited_re with code \[0-9\]+.*$gdb_prompt $" { + -re "$inferior_exited_re with code \[0-9\]+.*$gdb_prompt $" { if ![string match "" $message] then { set errmsg "$message (the program exited)" } else { @@ -782,7 +768,7 @@ proc gdb_test_multiple { command message user_code } { fail "$errmsg" set result -1 } - -re "$inferior_exited_re normally.*$gdb_prompt $" { + -re "$inferior_exited_re normally.*$gdb_prompt $" { if ![string match "" $message] then { set errmsg "$message (the program exited)" } else { @@ -791,7 +777,7 @@ proc gdb_test_multiple { command message user_code } { fail "$errmsg" set result -1 } - -re "The program is not being run.*$gdb_prompt $" { + -re "The program is not being run.*$gdb_prompt $" { if ![string match "" $message] then { set errmsg "$message (the program is no longer running)" } else { @@ -800,16 +786,16 @@ proc gdb_test_multiple { command message user_code } { fail "$errmsg" set result -1 } - -re "\r\n$gdb_prompt $" { + -re "\r\n$gdb_prompt $" { if ![string match "" $message] then { fail "$message" } set result 1 } - "" { + "" { send_gdb "\n" perror "Window too small." - fail "$message" + fail "$message" set result -1 } -re "\\((y or n|y or \\\[n\\\]|\\\[y\\\] or n)\\) " { @@ -824,16 +810,16 @@ proc gdb_test_multiple { command message user_code } { fail "$message (got breakpoint menu)" set result -1 } - eof { - perror "Process no longer exists" - if { $message != "" } { - fail "$message" - } - return -1 + eof { + perror "Process no longer exists" + if { $message != "" } { + fail "$message" + } + return -1 } - full_buffer { + full_buffer { perror "internal buffer is full." - fail "$message" + fail "$message" set result -1 } timeout { @@ -1317,7 +1303,7 @@ proc gdb_file_cmd { arg } { # get really slow. Give gdb at least 3 minutes to start up. # proc default_gdb_start { } { - global verbose + global verbose use_gdb_stub global GDB global INTERNAL_GDBFLAGS GDBFLAGS global gdb_prompt @@ -1326,6 +1312,15 @@ proc default_gdb_start { } { gdb_stop_suppressing_tests; + # Set the default value, it may be overriden later by specific testfile. + # + # Use `set_board_info use_gdb_stub' for the board file to flag the inferior + # is already started after connecting and run/attach are not supported. + # This is used for the "remote" protocol. After GDB starts you should + # check global $use_gdb_stub instead of the board as the testfile may force + # a specific different target protocol itself. + set use_gdb_stub [target_info exists use_gdb_stub] + verbose "Spawning $GDB $INTERNAL_GDBFLAGS $GDBFLAGS" if [info exists gdb_spawn_id] { @@ -1445,6 +1440,12 @@ proc skip_ada_tests {} { return 0 } +# Return a 1 if I don't even want to try to test GO. + +proc skip_go_tests {} { + return 0 +} + # Return a 1 if I don't even want to try to test java. proc skip_java_tests {} { @@ -1489,6 +1490,93 @@ proc skip_shlib_tests {} { return 1 } +# 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 +# variations of the same tests more than once, shall prefix the +# different test invocations with different identifying strings in +# order to make them unique. +# +# About test prefixes: +# +# $pf_prefix is the string that dejagnu prints after the result (FAIL, +# PASS, etc.), and before the test message/name in gdb.sum. E.g., the +# underlined substring in +# +# PASS: gdb.base/mytest.exp: some test +# ^^^^^^^^^^^^^^^^^^^^ +# +# is $pf_prefix. +# +# The easiest way to adjust the test prefix is to append a test +# variation prefix to the $pf_prefix, using the with_test_prefix +# procedure. E.g., +# +# proc do_tests {} { +# gdb_test ... ... "test foo" +# gdb_test ... ... "test bar" +# +# with_test_prefix "subvariation a" { +# gdb_test ... ... "test x" +# } +# +# with_test_prefix "subvariation b" { +# gdb_test ... ... "test x" +# } +# } +# +# with_test_prefix "variation1" { +# ...do setup for variation 1... +# do_tests +# } +# +# with_test_prefix "variation2" { +# ...do setup for variation 2... +# do_tests +# } +# +# Results in: +# +# PASS: gdb.base/mytest.exp: variation1: test foo +# PASS: gdb.base/mytest.exp: variation1: test bar +# PASS: gdb.base/mytest.exp: variation1: subvariation a: test x +# PASS: gdb.base/mytest.exp: variation1: subvariation b: test x +# PASS: gdb.base/mytest.exp: variation2: test foo +# PASS: gdb.base/mytest.exp: variation2: test bar +# PASS: gdb.base/mytest.exp: variation2: subvariation a: test x +# PASS: gdb.base/mytest.exp: variation2: subvariation b: test x +# +# If for some reason more flexibility is necessary, one can also +# manipulate the pf_prefix global directly, treating it as a string. +# E.g., +# +# global pf_prefix +# set saved_pf_prefix +# append pf_prefix "${foo}: bar" +# ... actual tests ... +# set pf_prefix $saved_pf_prefix +# + +# Run BODY in the context of the caller, with the current test prefix +# (pf_prefix) appended with one space, then PREFIX, and then a colon. +# Returns the result of BODY. +# +proc with_test_prefix { prefix body } { + global pf_prefix + + set saved $pf_prefix + append pf_prefix " " $prefix ":" + set code [catch {uplevel 1 $body} result] + set pf_prefix $saved + + 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. proc support_complex_tests {} { @@ -1739,7 +1827,7 @@ proc skip_altivec_tests {} { # Make sure we have a compiler that understands altivec. set compile_flags {debug nowarnings} - if [get_compiler_info not-used] { + if [get_compiler_info] { warning "Could not get compiler info" return 1 } @@ -1828,7 +1916,7 @@ proc skip_vsx_tests {} { # Make sure we have a compiler that understands altivec. set compile_flags {debug nowarnings quiet} - if [get_compiler_info not-used] { + if [get_compiler_info] { warning "Could not get compiler info" return 1 } @@ -2005,6 +2093,36 @@ proc skip_hw_watchpoint_access_tests {} { return 0 } +# Return 1 if we should skip tests that require the runtime unwinder +# hook. This must be invoked while gdb is running, after shared +# libraries have been loaded. This is needed because otherwise a +# shared libgcc won't be visible. + +proc skip_unwinder_tests {} { + global gdb_prompt + + set ok 0 + gdb_test_multiple "print _Unwind_DebugHook" "check for unwinder hook" { + -re "= .*no debug info.*_Unwind_DebugHook.*\r\n$gdb_prompt $" { + } + -re "= .*_Unwind_DebugHook.*\r\n$gdb_prompt $" { + set ok 1 + } + -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 $" { + } + } + } + return $ok +} + set compiler_info "unknown" set gcc_compiled 0 set hp_cc_compiler 0 @@ -2012,10 +2130,7 @@ set hp_aCC_compiler 0 # Figure out what compiler I am using. # -# BINFILE is a "compiler information" output file. This implementation -# does not use BINFILE. -# -# ARGS can be empty or "C++". If empty, "C" is assumed. +# ARG can be empty or "C++". If empty, "C" is assumed. # # There are several ways to do this, with various problems. # @@ -2064,7 +2179,7 @@ set hp_aCC_compiler 0 # # -- chastain 2004-01-06 -proc get_compiler_info {binfile args} { +proc get_compiler_info {{arg ""}} { # For compiler.c and compiler.cc global srcdir @@ -2082,7 +2197,7 @@ proc get_compiler_info {binfile args} { # Choose which file to preprocess. set ifile "${srcdir}/lib/compiler.c" - if { [llength $args] > 0 && [lindex $args 0] == "c++" } { + if { $arg == "c++" } { set ifile "${srcdir}/lib/compiler.cc" } @@ -2093,12 +2208,12 @@ proc get_compiler_info {binfile args} { # We have to use -E and -o together, despite the comments # above, because of how DejaGnu handles remote host testing. set ppout "$outdir/compiler.i" - gdb_compile "${ifile}" "$ppout" preprocess [list "$args" quiet] + gdb_compile "${ifile}" "$ppout" preprocess [list "$arg" quiet] set file [open $ppout r] set cppout [read $file] close $file } else { - set cppout [ gdb_compile "${ifile}" "" preprocess [list "$args" quiet] ] + set cppout [ gdb_compile "${ifile}" "" preprocess [list "$arg" quiet] ] } log_file -a "$outdir/$tool.log" @@ -2279,14 +2394,8 @@ proc gdb_compile {source dest type options} { } set options $new_options - if [target_info exists gdb_stub] { - set options2 { "additional_flags=-Dusestubs" } - lappend options "libs=[target_info gdb_stub]"; - set options [concat $options2 $options] - } if [target_info exists is_vxworks] { set options2 { "additional_flags=-Dvxworks" } - lappend options "libs=[target_info gdb_stub]"; set options [concat $options2 $options] } if [info exists GDB_TESTCASE_OPTIONS] { @@ -2945,12 +3054,15 @@ proc gdb_continue { function } { proc default_gdb_init { args } { global gdb_wrapper_initialized global gdb_wrapper_target + global gdb_test_file_name global cleanfiles set cleanfiles {} gdb_clear_suppressed; + set gdb_test_file_name [file rootname [file tail [lindex $args 0]]] + # Make sure that the wrapper is rebuilt # with the appropriate multilib option. if { $gdb_wrapper_target != [current_target_name] } { @@ -2978,6 +3090,88 @@ proc default_gdb_init { args } { } else { set gdb_prompt "\\(gdb\\)" } + global use_gdb_stub + if [info exists use_gdb_stub] { + unset use_gdb_stub + } +} + +# Turn BASENAME into a full file name in the standard output +# directory. It is ok if BASENAME is the empty string; in this case +# the directory is returned. + +proc standard_output_file {basename} { + global objdir subdir + + return [file join $objdir $subdir $basename] +} + +# Set 'testfile', 'srcfile', and 'binfile'. +# +# ARGS is a list of source file specifications. +# Without any arguments, the .exp file's base name is used to +# compute the source file name. The ".c" extension is added in this case. +# If ARGS is not empty, each entry is a source file specification. +# If the specification starts with a ".", it is treated as a suffix +# to append to the .exp file's base name. +# If the specification is the empty string, it is treated as if it +# were ".c". +# Otherwise it is a file name. +# The first file in the list is used to set the 'srcfile' global. +# Each subsequent name is used to set 'srcfile2', 'srcfile3', etc. +# +# Most tests should call this without arguments. +# +# If a completely different binary file name is needed, then it +# should be handled in the .exp file with a suitable comment. + +proc standard_testfile {args} { + global gdb_test_file_name + global subdir + global gdb_test_file_last_vars + + # Outputs. + global testfile binfile + + set testfile $gdb_test_file_name + set binfile [standard_output_file ${testfile}] + + if {[llength $args] == 0} { + set args .c + } + + # Unset our previous output variables. + # This can help catch hidden bugs. + if {[info exists gdb_test_file_last_vars]} { + foreach varname $gdb_test_file_last_vars { + global $varname + catch {unset $varname} + } + } + # 'executable' is often set by tests. + set gdb_test_file_last_vars {executable} + + set suffix "" + foreach arg $args { + set varname srcfile$suffix + global $varname + + # Handle an extension. + if {$arg == ""} { + set arg $testfile.c + } elseif {[string range $arg 0 0] == "."} { + set arg $testfile$arg + } + + set $varname $arg + lappend gdb_test_file_last_vars $varname + + if {$suffix == ""} { + set suffix 2 + } else { + incr suffix + } + } } # The default timeout used when testing GDB commands. We want to use @@ -2993,14 +3187,19 @@ if ![info exists gdb_test_timeout] { # an error when that happens. set banned_variables { bug_id prms_id } +# A list of procedures that GDB testcases should not use. +# We try to prevent their use by monitoring invocations and raising +# an error when that happens. +set banned_procedures { strace } + # gdb_init is called by runtest at start, but also by several # tests directly; gdb_finish is only called from within runtest after # each test source execution. # Placing several traces by repetitive calls to gdb_init leads # to problems, as only one trace is removed in gdb_finish. # To overcome this possible problem, we add a variable that records -# if the banned variables are traced. -set banned_variables_traced 0 +# if the banned variables and procedures are already traced. +set banned_traced 0 proc gdb_init { args } { # Reset the timeout value to the default. This way, any testcase @@ -3010,15 +3209,21 @@ proc gdb_init { args } { global timeout set timeout $gdb_test_timeout - # Block writes to all banned variables... + # Block writes to all banned variables, and invocation of all + # banned procedures... global banned_variables - global banned_variables_traced - if (!$banned_variables_traced) { + global banned_procedures + global banned_traced + if (!$banned_traced) { foreach banned_var $banned_variables { global "$banned_var" trace add variable "$banned_var" write error } - set banned_variables_traced 1 + foreach banned_proc $banned_procedures { + global "$banned_proc" + trace add execution "$banned_proc" enter error + } + set banned_traced 1 } # We set LC_ALL, LC_CTYPE, and LANG to C so that we get the same @@ -3067,13 +3272,18 @@ proc gdb_finish { } { # Unblock write access to the banned variables. Dejagnu typically # resets some of them between testcases. global banned_variables - global banned_variables_traced - if ($banned_variables_traced) { + global banned_procedures + global banned_traced + if ($banned_traced) { foreach banned_var $banned_variables { global "$banned_var" trace remove variable "$banned_var" write error } - set banned_variables_traced 0 + foreach banned_proc $banned_procedures { + global "$banned_proc" + trace remove execution "$banned_proc" enter error + } + set banned_traced 0 } } @@ -3147,95 +3357,10 @@ proc setup_kfail_for_target { PR target } { } } -# Test programs for embedded (often "bare board") systems sometimes use a -# "stub" either embedded in the test program itself or in the boot rom. -# The job of the stub is to implement the remote protocol to communicate -# with gdb and control the inferior. To initiate the remote protocol -# session with gdb the stub needs to be given control by the inferior. -# They do this by calling a function that typically triggers a trap -# from main that transfers control to the stub. -# The purpose of this function, gdb_step_for_stub, is to step out of -# that function ("breakpoint" in the example below) and back into main. -# -# Example: -# -# int -# main () -# { -# #ifdef usestubs -# set_debug_traps (); /* install trap handlers for stub */ -# breakpoint (); /* trigger a trap to give the stub control */ -# #endif -# /* test program begins here */ -# } -# -# Note that one consequence of this design is that a breakpoint on "main" -# does not Just Work (because if the target could stop there you still have -# to step past the calls to set_debug_traps,breakpoint). - -proc gdb_step_for_stub { } { - global gdb_prompt; - - if ![target_info exists gdb,use_breakpoint_for_stub] { - if [target_info exists gdb_stub_step_command] { - set command [target_info gdb_stub_step_command]; - } else { - set command "step"; - } - send_gdb "${command}\n"; - set tries 0; - gdb_expect 60 { - -re "(main.* at |.*in .*start).*$gdb_prompt" { - return; - } - -re ".*$gdb_prompt" { - incr tries; - if { $tries == 5 } { - fail "stepping out of breakpoint function"; - return; - } - send_gdb "${command}\n"; - exp_continue; - } - default { - fail "stepping out of breakpoint function"; - return; - } - } - } - send_gdb "where\n"; - gdb_expect { - -re "main\[^\r\n\]*at \(\[^:]+\):\(\[0-9\]+\)" { - set file $expect_out(1,string); - set linenum [expr $expect_out(2,string) + 1]; - set breakplace "${file}:${linenum}"; - } - default {} - } - send_gdb "break ${breakplace}\n"; - gdb_expect 60 { - -re "Breakpoint (\[0-9\]+) at.*$gdb_prompt" { - set breakpoint $expect_out(1,string); - } - -re "Breakpoint (\[0-9\]+): file.*$gdb_prompt" { - set breakpoint $expect_out(1,string); - } - default {} - } - send_gdb "continue\n"; - gdb_expect 60 { - -re "Breakpoint ${breakpoint},.*$gdb_prompt" { - gdb_test "delete $breakpoint" ".*" ""; - return; - } - default {} - } -} - # gdb_get_line_number TEXT [FILE] # # Search the source file FILE, and return the line number of the -# first line containing TEXT. If no match is found, return -1. +# first line containing TEXT. If no match is found, an error is thrown. # # TEXT is a string literal, not a regular expression. # @@ -3308,15 +3433,13 @@ proc gdb_get_line_number { text { file "" } } { } if { [ catch { set fd [open "$file"] } message ] } then { - perror "$message" - return -1 + error "$message" } set found -1 for { set line 1 } { 1 } { incr line } { if { [ catch { set nchar [gets "$fd" body] } message ] } then { - perror "$message" - return -1 + error "$message" } if { $nchar < 0 } then { break @@ -3328,8 +3451,11 @@ proc gdb_get_line_number { text { file "" } } { } if { [ catch { close "$fd" } message ] } then { - perror "$message" - return -1 + error "$message" + } + + if {$found == -1} { + error "undefined tag \"$text\"" } return $found @@ -3350,7 +3476,7 @@ proc gdb_get_line_number { text { file "" } } { # is accepted. proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} { - global inferior_exited_re + global inferior_exited_re use_gdb_stub if {$mssg == ""} { set text "continue until exit" @@ -3362,7 +3488,7 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} { } else { set extra "" } - if [target_info exists use_gdb_stub] { + if $use_gdb_stub { if {![gdb_breakpoint "exit"]} { return 0 } @@ -3379,9 +3505,9 @@ proc gdb_continue_to_end {{mssg ""} {command continue} {allow_extra 0}} { } proc rerun_to_main {} { - global gdb_prompt + global gdb_prompt use_gdb_stub - if [target_info exists use_gdb_stub] { + if $use_gdb_stub { gdb_run_cmd gdb_expect { -re ".*Breakpoint .*main .*$gdb_prompt $"\ @@ -3638,29 +3764,31 @@ proc test_prefix_command_help { command_list expected_initial_lines args } { } } -# Build executable named EXECUTABLE, from SOURCES. If SOURCES are not -# provided, uses $EXECUTABLE.c. The TESTNAME paramer is the name of test -# to pass to untested, if something is wrong. OPTIONS are passed -# to gdb_compile directly. -proc build_executable { testname executable {sources ""} {options {debug}} } { - - global objdir +# Build executable named EXECUTABLE from specifications that allow +# different options to be passed to different sub-compilations. +# TESTNAME is the name of the test; this is passed to 'untested' if +# something fails. +# OPTIONS is passed to the final link, using gdb_compile. +# ARGS is a flat list of source specifications, of the form: +# { SOURCE1 OPTIONS1 [ SOURCE2 OPTIONS2 ]... } +# Each SOURCE is compiled to an object file using its OPTIONS, +# using gdb_compile. +# Returns 0 on success, -1 on failure. +proc build_executable_from_specs {testname executable options args} { global subdir global srcdir - if {[llength $sources]==0} { - set sources ${executable}.c - } - set binfile ${objdir}/${subdir}/${executable} + set binfile [standard_output_file $executable] set objects {} - for {set i 0} "\$i<[llength $sources]" {incr i} { - set s [lindex $sources $i] - if { [gdb_compile "${srcdir}/${subdir}/${s}" "${binfile}${i}.o" object $options] != "" } { + set i 0 + foreach {s local_options} $args { + if { [gdb_compile "${srcdir}/${subdir}/${s}" "${binfile}${i}.o" object $local_options] != "" } { untested $testname return -1 } lappend objects "${binfile}${i}.o" + incr i } if { [gdb_compile $objects "${binfile}" executable $options] != "" } { @@ -3672,28 +3800,59 @@ proc build_executable { testname executable {sources ""} {options {debug}} } { if { [lsearch -exact $options "c++"] >= 0 } { set info_options "c++" } - if [get_compiler_info ${binfile} ${info_options}] { + if [get_compiler_info ${info_options}] { return -1 } return 0 } +# Build executable named EXECUTABLE, from SOURCES. If SOURCES are not +# provided, uses $EXECUTABLE.c. The TESTNAME paramer is the name of test +# to pass to untested, if something is wrong. OPTIONS are passed +# to gdb_compile directly. +proc build_executable { testname executable {sources ""} {options {debug}} } { + if {[llength $sources]==0} { + set sources ${executable}.c + } + + set arglist [list $testname $executable $options] + foreach source $sources { + lappend arglist $source $options + } + + return [eval build_executable_from_specs $arglist] +} + # Starts fresh GDB binary and loads EXECUTABLE into GDB. EXECUTABLE is -# the name of binary in ${objdir}/${subdir}. +# the basename of the binary. proc clean_restart { executable } { global srcdir - global objdir global subdir - set binfile ${objdir}/${subdir}/${executable} + set binfile [standard_output_file ${executable}] gdb_exit gdb_start gdb_reinitialize_dir $srcdir/$subdir gdb_load ${binfile} +} - if [target_info exists gdb_stub] { - gdb_step_for_stub; - } +# Prepares for testing by calling build_executable_full, then +# clean_restart. +# TESTNAME is the name of the test. +# Each element in ARGS is a list of the form +# { EXECUTABLE OPTIONS SOURCE_SPEC... } +# These are passed to build_executable_from_specs, which see. +# The last EXECUTABLE is passed to clean_restart. +# Returns 0 on success, non-zero on failure. +proc prepare_for_testing_full {testname args} { + foreach spec $args { + if {[eval build_executable_from_specs [list $testname] $spec] == -1} { + return -1 + } + set executable [lindex $spec 0] + } + clean_restart $executable + return 0 } # Prepares for testing, by calling build_executable, and then clean_restart. @@ -3857,7 +4016,7 @@ proc core_find {binfile {deletefiles {}} {arg ""}} { # could have many core files lying around, and it may be difficult to # tell which one is ours, so let's run the program in a subdirectory. set found 0 - set coredir "${objdir}/${subdir}/coredir.[getpid]" + set coredir [standard_output_file coredir.[getpid]] file mkdir $coredir catch "system \"(cd ${coredir}; ulimit -c unlimited; ${binfile} ${arg}; true) >/dev/null 2>&1\"" # remote_exec host "${binfile}"