| proc gdb_emc_readvar { varname } { |
| global gdb_prompt; |
| |
| set result -1; |
| send_gdb "print $varname\n" |
| gdb_expect 5 { |
| -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" { |
| set result $expect_out(1,string); |
| } |
| -re "$gdb_prompt $" { } |
| default { } |
| } |
| return $result; |
| } |
| |
| proc gdb_emc_gettpnum { testname } { |
| global gdb_prompt; |
| |
| if { $testname != "" } { |
| gdb_test "trace $testname" "" "" |
| } |
| return [gdb_emc_readvar "\$tpnum"]; |
| } |
| |
| proc gdb_emc_setactions { testname actionname args } { |
| global gdb_prompt; |
| |
| set state 0; |
| set status "pass"; |
| send_gdb "actions $actionname\n"; |
| set expected_result ""; |
| gdb_expect 5 { |
| -re "No tracepoint number .*$gdb_prompt $" { |
| fail $testname |
| return 1; |
| } |
| -re "Enter actions for tracepoint $actionname.*>" { |
| 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 != "" } { |
| # Remove echoed command and its associated newline. |
| regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out; |
| # Strip off any newlines at the end of the string. |
| regsub "\[\r\n\]+$" "$out" "" out; |
| verbose "expected '$expected_result', got '$out', expect_out is '$expect_out(1,string)'"; |
| if ![regexp $expected_result $out] { |
| set status "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 status "fail"; |
| } |
| set expected_result ""; |
| } |
| if { [llength $args] < $state } { |
| set status "fail"; |
| } |
| } |
| default { |
| set status "fail"; |
| } |
| } |
| if { $testname != "" } { |
| $status $testname; |
| } |
| if { $status == "pass" } then { |
| return 0; |
| } else { |
| return 1; |
| } |
| } |
| |
| # |
| # test collect command |
| # |
| |
| proc gdb_emc_tracetest_collect { arg1 msgstring } { |
| global decimal |
| global gdb_prompt; |
| |
| set teststate 0 |
| gdb_expect 30 { |
| -re "Enter actions for tracepoint $decimal.*> $" { |
| send_gdb "collect $arg1\n" |
| incr teststate; |
| exp_continue |
| } |
| -re "> $" { |
| if { $teststate == 1 } { |
| send_gdb "end\n" |
| incr teststate; |
| exp_continue |
| } else { |
| fail "$msgstring" |
| } |
| } |
| -re ".*$gdb_prompt $" { |
| if { $teststate == 2 } { |
| pass "$msgstring"; |
| } else { |
| fail "$msgstring"; |
| } |
| } |
| default { |
| fail "$msgstring (default)"; |
| } |
| } |
| regsub -all "(\[($@*+)\])" "collect $arg1" "\[\\1\]" arg1_regexp; |
| gdb_test "info tracepoints" ".*$arg1_regexp.*" "$msgstring info tracepoint" |
| } |
| |
| 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 $" { } |
| timeout { fail "delete all tracepoints (timeout)" } |
| } |
| } |
| |
| |
| # Send each command in the list CMDLIST to gdb. If we see the string |
| # "error" or "warning" from gdb, we assume an error has occured and |
| # return a non-zero result. All of the commands in CMDLIST are always |
| # sent, even if an error occurs. |
| # If TESTNAME is non-null, we call pass or fail with the string in TESTNAME |
| # depending on whether or not an error/warning has occurred. |
| # |
| proc gdb_do_cmdlist { cmdlist testname } { |
| global gdb_prompt; |
| |
| set status 0; |
| |
| foreach x $cmdlist { |
| send_gdb "$x\n"; |
| gdb_expect 60 { |
| -re "\[Ee\]rror|\[Ww\]arning" { |
| set status 1; |
| exp_continue; |
| } |
| -re "$gdb_prompt $" { } |
| -re "\[\r\n\]\[ \t\]*> *$" { } |
| } |
| } |
| if { $testname != "" } { |
| if { $status == 0 } { |
| pass "$testname"; |
| } else { |
| fail "$testname"; |
| } |
| } |
| return $status; |
| } |
| |
| # |
| # Given the file FILENAME, we read it as a list of commands and generate |
| # a list suitable for use by gdb_do_cmdlist. Lines beginning with # are |
| # ignored; blank lines are interpreted as empty lines to be sent to gdb. |
| # |
| proc gdb_process_cmdfile { filename } { |
| set id [open $filename "r"]; |
| if { $id < 0 } { |
| return ""; |
| } |
| set result {}; |
| while { [gets $id line] >= 0 } { |
| if [regexp "^#" $line] { |
| continue; |
| } |
| set result [concat $result [list "$line"]]; |
| } |
| close $id; |
| return $result; |
| } |
| |
| # gdb_find_c_test_baseline |
| # returns -1 on failure (CALLER MUST CHECK RETURN!) |
| proc gdb_find_c_test_baseline { } { |
| global gdb_prompt; |
| |
| set gdb_c_test_baseline -1; |
| |
| send_gdb "list gdb_c_test\n" |
| gdb_expect { |
| -re "void.*p5,.*void.*p6.*\[\r\n\](\[0-9\]+)\[\t \]+\{.*$gdb_prompt $" { |
| set gdb_c_test_baseline $expect_out(1,string) |
| } |
| -re "$gdb_prompt $" { } |
| default { } |
| } |
| return $gdb_c_test_baseline; |
| } |
| |
| |