Subversion Repositories scarts

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;

}