old-cross-binutils/gdb/testsuite/lib/emc-support.exp

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