OpenCores
URL https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gdb-6.8/] [gdb/] [testsuite/] [lib/] [emc-support.exp] - Blame information for rev 307

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 24 jeremybenn
proc gdb_emc_readvar { varname } {
2
    global gdb_prompt;
3
 
4
    set result -1;
5
    send_gdb "print $varname\n"
6
    gdb_expect 5 {
7
        -re "\[$\].*= (\[0-9\]+).*$gdb_prompt $" {
8
            set result $expect_out(1,string);
9
        }
10
        -re "$gdb_prompt $" { }
11
        default { }
12
    }
13
    return $result;
14
}
15
 
16
proc gdb_emc_gettpnum { testname } {
17
    global gdb_prompt;
18
 
19
    if { $testname != "" } {
20
        gdb_test "trace $testname" "" ""
21
    }
22
    return [gdb_emc_readvar "\$tpnum"];
23
}
24
 
25
proc gdb_emc_setactions { testname actionname args } {
26
    global gdb_prompt;
27
 
28
    set state 0;
29
    set status "pass";
30
    send_gdb "actions $actionname\n";
31
    set expected_result "";
32
    gdb_expect 5 {
33
        -re "No tracepoint number .*$gdb_prompt $" {
34
            fail $testname
35
            return 1;
36
        }
37
        -re "Enter actions for tracepoint $actionname.*>" {
38
            if { [llength $args] > 0 } {
39
                set lastcommand "[lindex $args $state]";
40
                send_gdb "[lindex $args $state]\n";
41
                incr state;
42
                set expected_result [lindex $args $state];
43
                incr state;
44
            } else {
45
                send_gdb "end\n";
46
            }
47
            exp_continue;
48
        }
49
        -re "\(.*\[\r\n\]+)\[ \t]*> $" {
50
            if { $expected_result != "" } {
51
                # Remove echoed command and its associated newline.
52
                regsub "^\[^\r\n\]+\[\r\n\]+" "$expect_out(1,string)" "" out;
53
                # Strip off any newlines at the end of the string.
54
                regsub "\[\r\n\]+$" "$out" "" out;
55
                verbose "expected '$expected_result', got '$out', expect_out is '$expect_out(1,string)'";
56
                if ![regexp $expected_result $out] {
57
                    set status "fail";
58
                }
59
                set expected_result "";
60
            }
61
            if { $state < [llength $args] } {
62
                send_gdb "[lindex $args $state]\n";
63
                incr state;
64
                set expected_result [lindex $args $state];
65
                incr state;
66
            } else {
67
                send_gdb "end\n";
68
                set expected_result "";
69
            }
70
            exp_continue;
71
        }
72
        -re "\(.*\)$gdb_prompt $" {
73
            if { $expected_result != "" } {
74
                if ![regexp $expected_result $expect_out(1,string)] {
75
                    set status "fail";
76
                }
77
                set expected_result "";
78
            }
79
            if { [llength $args] < $state } {
80
                set status "fail";
81
            }
82
        }
83
        default {
84
            set status "fail";
85
        }
86
    }
87
    if { $testname != "" } {
88
        $status $testname;
89
    }
90
    if { $status == "pass" } then {
91
        return 0;
92
    } else {
93
        return 1;
94
    }
95
}
96
 
97
#
98
# test collect command
99
#
100
 
101
proc gdb_emc_tracetest_collect { arg1 msgstring } {
102
    global decimal
103
    global gdb_prompt;
104
 
105
    set teststate 0
106
    gdb_expect 30 {
107
        -re "Enter actions for tracepoint $decimal.*> $" {
108
            send_gdb "collect $arg1\n"
109
            incr teststate;
110
            exp_continue
111
        }
112
        -re "> $" {
113
            if { $teststate == 1 } {
114
                send_gdb "end\n"
115
                incr teststate;
116
                exp_continue
117
            } else {
118
                fail "$msgstring"
119
            }
120
        }
121
        -re ".*$gdb_prompt $" {
122
            if { $teststate == 2 } {
123
                pass "$msgstring";
124
            } else {
125
                fail "$msgstring";
126
            }
127
        }
128
        default {
129
            fail "$msgstring (default)";
130
        }
131
    }
132
    regsub -all "(\[($@*+)\])" "collect $arg1" "\[\\1\]" arg1_regexp;
133
    gdb_test "info tracepoints" ".*$arg1_regexp.*" "$msgstring info tracepoint"
134
}
135
 
136
proc gdb_delete_tracepoints { } {
137
    global gdb_prompt;
138
 
139
    send_gdb "delete tracepoints\n"
140
    gdb_expect 30 {
141
        -re "Delete all tracepoints.*y or n.*$" {
142
            send_gdb "y\n"
143
            exp_continue;
144
        }
145
        -re "$gdb_prompt $" { }
146
        timeout { fail "delete all tracepoints (timeout)" }
147
    }
148
}
149
 
150
 
151
# Send each command in the list CMDLIST to gdb. If we see the string
152
# "error" or "warning" from gdb, we assume an error has occured and
153
# return a non-zero result. All of the commands in CMDLIST are always
154
# sent, even if an error occurs.
155
# If TESTNAME is non-null, we call pass or fail with the string in TESTNAME
156
# depending on whether or not an error/warning has occurred.
157
#
158
proc gdb_do_cmdlist { cmdlist testname } {
159
    global gdb_prompt;
160
 
161
    set status 0;
162
 
163
    foreach x $cmdlist {
164
        send_gdb "$x\n";
165
        gdb_expect 60 {
166
            -re "\[Ee\]rror|\[Ww\]arning" {
167
                set status 1;
168
                exp_continue;
169
            }
170
            -re "$gdb_prompt $" { }
171
            -re "\[\r\n\]\[ \t\]*> *$" { }
172
        }
173
    }
174
    if { $testname != "" } {
175
        if { $status == 0 } {
176
            pass "$testname";
177
        } else {
178
            fail "$testname";
179
        }
180
    }
181
    return $status;
182
}
183
 
184
#
185
# Given the file FILENAME, we read it as a list of commands and generate
186
# a list suitable for use by gdb_do_cmdlist. Lines beginning with # are
187
# ignored; blank lines are interpreted as empty lines to be sent to gdb.
188
#
189
proc gdb_process_cmdfile { filename } {
190
    set id [open $filename "r"];
191
    if { $id < 0 } {
192
        return "";
193
    }
194
    set result {};
195
    while { [gets $id line] >= 0 } {
196
        if [regexp "^#" $line] {
197
            continue;
198
        }
199
        set result [concat $result [list "$line"]];
200
    }
201
    close $id;
202
    return $result;
203
}
204
 
205
# gdb_find_c_test_baseline
206
# returns -1 on failure (CALLER MUST CHECK RETURN!)
207
proc gdb_find_c_test_baseline { } {
208
    global gdb_prompt;
209
 
210
    set gdb_c_test_baseline -1;
211
 
212
    send_gdb "list gdb_c_test\n"
213
    gdb_expect {
214
        -re "void.*p5,.*void.*p6.*\[\r\n\](\[0-9\]+)\[\t \]+\{.*$gdb_prompt $" {
215
            set gdb_c_test_baseline $expect_out(1,string)
216
        }
217
        -re "$gdb_prompt $" { }
218
        default { }
219
    }
220
    return $gdb_c_test_baseline;
221
}
222
 
223
 

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.