Sync usage with man page.

[netbsd-mini2440.git] / gnu / dist / gdb6 / 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;
}