diff options
Diffstat (limited to 'gdb/testsuite/lib/trace-support.exp')
| -rw-r--r-- | gdb/testsuite/lib/trace-support.exp | 307 |
1 files changed, 307 insertions, 0 deletions
diff --git a/gdb/testsuite/lib/trace-support.exp b/gdb/testsuite/lib/trace-support.exp new file mode 100644 index 00000000000..4765791b817 --- /dev/null +++ b/gdb/testsuite/lib/trace-support.exp @@ -0,0 +1,307 @@ +# Copyright (C) 1998 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 2 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, write to the Free Software +# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. + +# Please email any bugs, comments, and/or additions to this file to: +# bug-gdb@prep.ai.mit.edu + + +# +# Support procedures for trace testing +# + + +# +# Procedure: gdb_target_supports_trace +# Returns true if GDB is connected to a target that supports tracing. +# Allows tests to abort early if not running on a trace-aware target. +# + +proc gdb_target_supports_trace { } { + global gdb_prompt + + send_gdb "tstatus\n" + gdb_expect { + -re "\[Tt\]race can only be run on.*$gdb_prompt $" { + return 0 + } + -re "\[Tt\]race can not be run on.*$gdb_prompt $" { + return 0 + } + -re "\[Tt\]arget does not support.*$gdb_prompt $" { + return 0 + } + -re ".*\[Ee\]rror.*$gdb_prompt $" { + return 0 + } + -re ".*\[Ww\]arning.*$gdb_prompt $" { + return 0 + } + -re ".*$gdb_prompt $" { + return 1 + } + timeout { + return 0 + } + } +} + + +# +# Procedure: gdb_delete_tracepoints +# Many of the tests depend on setting tracepoints at various places and +# running until that tracepoint is reached. At times, we want to start +# with a clean slate with respect to tracepoints, so this utility proc +# lets us do this without duplicating this code everywhere. +# + +proc gdb_delete_tracepoints {} { + global gdb_prompt + + send_gdb "delete tracepoints\n" + gdb_expect 30 { + -re "Delete all tracepoints.*y or n.*$" { + send_gdb "y\n"; + exp_continue + } + -re ".*$gdb_prompt $" { # This happens if there were no tracepoints } + timeout { + perror "Delete all tracepoints in delete_tracepoints (timeout)" + return + } + } + send_gdb "info tracepoints\n" + gdb_expect 30 { + -re "No tracepoints.*$gdb_prompt $" {} + -re "$gdb_prompt $" { perror "tracepoints not deleted" ; return } + timeout { perror "info tracepoints (timeout)" ; return } + } +} + +# +# Procedure: gdb_trace_setactions +# Define actions for a tracepoint. +# Arguments: +# testname -- identifying string for pass/fail output +# tracepoint -- to which tracepoint do these actions apply? (optional) +# args -- list of actions to be defined. +# Returns: +# zero -- success +# non-zero -- failure + +proc gdb_trace_setactions { testname tracepoint args } { + global gdb_prompt; + + set state 0; + set passfail "pass"; + send_gdb "actions $tracepoint\n"; + set expected_result ""; + gdb_expect 5 { + -re "No tracepoint number .*$gdb_prompt $" { + fail $testname + return 1; + } + -re "Enter actions for tracepoint $tracepoint.*>" { + if { [llength $args] > 0 } { + set lastcommand "[lindex $args $state]"; + send_gdb "[lindex $args $state]\n"; + incr state; + set expected_result [lindex $args $state]; + incr state; + } else { + send_gdb "end\n"; + } + exp_continue; + } + -re "\(.*\)\[\r\n\]+\[ \t]*> $" { + if { $expected_result != "" } { + regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out; + if ![regexp $expected_result $out] { + set passfail "fail"; + } + set expected_result ""; + } + if { $state < [llength $args] } { + send_gdb "[lindex $args $state]\n"; + incr state; + set expected_result [lindex $args $state]; + incr state; + } else { + send_gdb "end\n"; + set expected_result ""; + } + exp_continue; + } + -re "\(.*\)$gdb_prompt $" { + if { $expected_result != "" } { + if ![regexp $expected_result $expect_out(1,string)] { + set passfail "fail"; + } + set expected_result ""; + } + if { [llength $args] < $state } { + set passfail "fail"; + } + } + default { + set passfail "fail"; + } + } + if { $testname != "" } { + $passfail $testname; + } + if { $passfail == "pass" } then { + return 0; + } else { + return 1; + } +} + +# +# Procedure: gdb_tfind_test +# Find a specified trace frame. +# Arguments: +# testname -- identifying string for pass/fail output +# tfind_arg -- frame (line, PC, etc.) identifier +# exp_res -- Expected result of frame test +# args -- Test expression +# Returns: +# zero -- success +# non-zero -- failure +# + +proc gdb_tfind_test { testname tfind_arg exp_res args } { + global gdb_prompt; + + if { "$args" != "" } { + set expr "$exp_res"; + set exp_res "$args"; + } else { + set expr "(int) \$trace_frame"; + } + set passfail "fail"; + + gdb_test "tfind $tfind_arg" "" "" + send_gdb "printf \"x \%d x\\n\", $expr\n"; + gdb_expect 10 { + -re "x (-*\[0-9\]+) x" { + if { $expect_out(1,string) == $exp_res } { + set passfail "pass"; + } + exp_continue; + } + -re "$gdb_prompt $" { } + } + $passfail "$testname"; + if { $passfail == "pass" } then { + return 0; + } else { + return 1; + } +} + +# +# Procedure: gdb_readexpr +# Arguments: +# gdb_expr -- the expression whose value is desired +# Returns: +# the value of gdb_expr, as evaluated by gdb. +# [FIXME: returns -1 on error, which is sometimes a legit value] +# + +proc gdb_readexpr { gdb_expr } { + global gdb_prompt; + + set result -1; + send_gdb "print $gdb_expr\n" + gdb_expect 5 { + -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" { + set result $expect_out(1,string); + } + -re "$gdb_prompt $" { } + default { } + } + return $result; +} + +# +# Procedure: gdb_gettpnum +# Arguments: +# tracepoint (optional): if supplied, set a tracepoint here. +# Returns: +# the tracepoint ID of the most recently set tracepoint. +# + +proc gdb_gettpnum { tracepoint } { + global gdb_prompt; + + if { $tracepoint != "" } { + gdb_test "trace $tracepoint" "" "" + } + return [gdb_readexpr "\$tpnum"]; +} + + +# +# Procedure: gdb_find_function_baseline +# Arguments: +# func_name -- name of source function +# Returns: +# Sourcefile line of function definition (open curly brace), +# or -1 on failure. Caller must check return value. +# Note: +# Works only for open curly brace at beginning of source line! +# + +proc gdb_find_function_baseline { func_name } { + global gdb_prompt; + + set baseline -1; + + send_gdb "list $func_name\n" +# gdb_expect { +# -re "\[\r\n\]\[\{\].*$gdb_prompt $" { +# set baseline 1 +# } +# } +} + +# +# Procedure: gdb_find_function_baseline +# Arguments: +# filename: name of source file of desired function. +# Returns: +# Sourcefile line of function definition (open curly brace), +# or -1 on failure. Caller must check return value. +# Note: +# Works only for open curly brace at beginning of source line! +# + +proc gdb_find_recursion_test_baseline { filename } { + global gdb_prompt; + + set baseline -1; + + gdb_test "list $filename:1" "" "" + send_gdb "search gdb_recursion_test line 0\n" + gdb_expect { + -re "(\[0-9\]+)\[\t \]+\{.*line 0.*$gdb_prompt $" { + set baseline $expect_out(1,string); + } + -re "$gdb_prompt $" { } + default { } + } + return $baseline; +} |