diff options
Diffstat (limited to 'gdb/testsuite/lib/gdb.exp')
| -rw-r--r-- | gdb/testsuite/lib/gdb.exp | 227 |
1 files changed, 222 insertions, 5 deletions
diff --git a/gdb/testsuite/lib/gdb.exp b/gdb/testsuite/lib/gdb.exp index 3103f86..b2f3ba9 100644 --- a/gdb/testsuite/lib/gdb.exp +++ b/gdb/testsuite/lib/gdb.exp @@ -101,7 +101,7 @@ proc gdb_unload {} { global gdb_prompt send_gdb "file\n" gdb_expect 60 { - -re "No exec file now\[^\r\n\]*\[\r\n\]" { exp_continue } + -re "No executable file now\[^\r\n\]*\[\r\n\]" { exp_continue } -re "No symbol file now\[^\r\n\]*\[\r\n\]" { exp_continue } -re "A program is being debugged already..*Kill it.*y or n. $"\ { send_gdb "y\n" @@ -406,6 +406,13 @@ proc gdb_test { args } { } } gdb_expect $tmt { + -re "\\*\\*\\* DOSEXIT code.*" { + if { $message != "" } { + fail "$message"; + } + gdb_suppress_entire_file "GDB died"; + return -1; + } -re "Ending remote debugging.*$gdb_prompt$" { if ![isnative] then { warning "Can`t communicate to remote target." @@ -827,23 +834,128 @@ proc skip_chill_tests {} { return $skip_chill } -proc get_compiler_info {binfile} { +# skip all the tests in the file if you are not on an hppa running hpux target. +# and you compiled with gcc +proc skip_hp_tests {gcc_used} { + # if ![info exists do_hp_tests] { + # return 1; + # } + eval set skip_hp [expr ![isnative] || ![istarget "hppa*-*-hpux*"] || $gcc_used!=0 ] + verbose "Skip hp tests is $skip_hp" + return $skip_hp +} + +proc get_compiler_info {binfile args} { # Create and source the file that provides information about the compiler # used to compile the test case. + # Compiler_type can be null or c++. If null we assume c. global srcdir global subdir # These two come from compiler.c. global signed_keyword_not_used global gcc_compiled - if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } { - perror "Couldn't make ${binfile}.ci file" - return 1; + if {![istarget "hppa*-*-hpux*"]} { + if { [llength $args] > 0 } { + if {$args == "c++"} { + if { [gdb_compile "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci" preprocess {}] != "" } { + perror "Couldn't make ${binfile}.ci file" + return 1; + } + } + } else { + if { [gdb_compile "${srcdir}/${subdir}/compiler.c" "${binfile}.ci" preprocess {}] != "" } { + perror "Couldn't make ${binfile}.ci file" + return 1; + } + } + } else { + if { [llength $args] > 0 } { + if {$args == "c++"} { + if { [eval gdb_preprocess \ + [list "${srcdir}/${subdir}/compiler.cc" "${binfile}.ci"] \ + $args] != "" } { + perror "Couldn't make ${binfile}.ci file" + return 1; + } + } + } else { + if { [eval gdb_preprocess \ + [list "${srcdir}/${subdir}/compiler.c" "${binfile}.ci"] \ + $args] != "" } { + perror "Couldn't make ${binfile}.ci file" + return 1; + } + } } + source ${binfile}.ci return 0; } +proc gdb_preprocess {source dest args} { + global CC_FOR_TARGET + global CXX_FOR_TARGET + + if { [llength $args] == 0 } { + set which_compiler "c" + } else { + if { $args =="c++" } { + set which_compiler "c++" + } else { + perror "Unknown compiler type supplied to gdb_preprocess" + return 1; + } + } + + if [info exists CC_FOR_TARGET] { + if { $which_compiler == "c"} { + set compiler $CC_FOR_TARGET; + } + } + + if [info exists CXX_FOR_TARGET] { + if { $which_compiler == "c++"} { + set compiler $CXX_FOR_TARGET; + } + } + + if { ![info exists compiler] } { + if { $which_compiler == "c" } { + if {[info exists CC]} { + set compiler $CC; + } + } + if { $which_compiler == "c++" } { + if {[info exists CXX]} { + set compiler $CXX; + } + } + if {![info exists compiler]} { + set compiler [board_info [target_info name] compiler]; + if { $compiler == "" } { + puts "default_target_compile: No compiler to compile with"; + return "default_target_compile: No compiler to compile with"; + } + } + } + + set cmdline "$compiler -E $source > $dest" + + puts "Invoking $compiler -E $source > $dest" + verbose "Invoking $compiler -E $source > $dest" + verbose -log "Executing on local host: $cmdline" 2 + set status [catch "exec ${cmdline}" exec_output] + + set result [prune_warnings $exec_output] + regsub "\[\r\n\]*$" "$result" "" result; + regsub "^\[\r\n\]*" "$result" "" result; + if { $result != "" } { + clone_output "gdb compile failed, $result" + } + return $result; +} + proc gdb_compile {source dest type options} { global GDB_TESTCASE_OPTIONS; @@ -862,6 +974,7 @@ proc gdb_compile {source dest type options} { } verbose "options are $options" verbose "source is $source $dest $type $options" + set result [target_compile $source $dest $type $options]; regsub "\[\r\n\]*$" "$result" "" result; regsub "^\[\r\n\]*" "$result" "" result; @@ -1154,3 +1267,107 @@ proc gdb_step_for_stub { } { default {} } } + +# start-sanitize-gdbtk +# From dejagnu: +# srcdir = testsuite src dir (e.g., devo/gdb/testsuite) +# objdir = testsuite obj dir (e.g., gdb/testsuite) +# subdir = subdir of testsuite (e.g., gdb.gdbtk) +# +# To gdbtk: +# env(DEFS)=the "defs" files (e.g., devo/gdb/testsuite/gdb.gdbtk/defs) +# env(SRCDIR)=directory containing the test code (e.g., *.test) +# env(OBJDIR)=directory which contains any executables +# (e.g., gdb/testsuite/gdb.gdbtk) +proc gdbtk_start {test} { + global verbose + global GDB + global GDBFLAGS + global env srcdir subdir objdir + + gdb_stop_suppressing_tests; + + verbose "Starting $GDB -nx -q --tclcommand=$test" + + set real_test [which $test] + if {$real_test == 0} { + perror "$test is not found" + exit 1 + } + + if {![is_remote host]} { + if { [which $GDB] == 0 } { + perror "$GDB does not exist." + exit 1 + } + } + + set wd [pwd] + cd [file join $srcdir .. gdbtcl2] + set env(GDBTK_LIBRARY) [pwd] + cd [file join $srcdir .. .. tcl library] + set env(TCL_LIBRARY) [pwd] + cd [file join $srcdir .. .. tk library] + set env(TK_LIBRARY) [pwd] + cd [file join $srcdir .. .. tix library] + set env(TIX_LIBRARY) [pwd] + cd [file join $srcdir .. .. itcl itcl library] + set env(ITCL_LIBRARY) [pwd] + cd [file join .. $srcdir .. .. libgui library] + set env(CYGNUS_GUI_LIBRARY) [pwd] + cd $wd + cd [file join $srcdir $subdir] + set env(DEFS) [file join [pwd] defs] + cd $wd + cd [file join $objdir $subdir] + set env(OBJDIR) [pwd] + cd $wd + cd $srcdir + set env(SRCDIR) [pwd] + cd $wd + set env(GDBTK_VERBOSE) 1 + set env(GDBTK_LOGFILE) [file join $objdir gdb.log] + set env(GDBTK_TEST_RUNNING) 1 + set err [catch {exec $GDB -nx -q --tclcommand=$test} res] + if { $err } { + perror "Execing $GDB failed: $res" + exit 1; + } + return $res +} + +# gdbtk tests call this function to print out the results of the +# tests. The argument is a proper list of lists of the form: +# {status name description msg}. All of these things typically +# come from the testsuite harness. +proc gdbtk_analyze_results {results} { + foreach test $results { + set status [lindex $test 0] + set name [lindex $test 1] + set description [lindex $test 2] + set msg [lindex $test 3] + + switch $status { + PASS { + pass "$description ($name)" + } + + FAIL { + fail "$description ($name)" + } + + ERROR { + perror "$name" + } + + XFAIL { + xfail "$description ($name)" + } + + XPASS { + xpass "$description ($name)" + } + } + } +} +# end-sanitize-gdbtk |