old-cross-binutils/gdb/testsuite/lib/emc-support.exp
1999-04-16 01:35:26 +00:00

223 lines
5.1 KiB
Text

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