1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
|
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;
}
|
