URL
https://opencores.org/ocsvn/or1k/or1k/trunk
Subversion Repositories or1k
[/] [or1k/] [trunk/] [gdb-5.3/] [gdb/] [testsuite/] [lib/] [emc-support.exp] - Rev 1765
Compare with Previous | Blame | View Log
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 $testnamereturn 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 decimalglobal gdb_prompt;set teststate 0gdb_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;}
