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; }