78 |
} |
} |
79 |
} |
} |
80 |
|
|
81 |
|
proc mu_start {args} { |
82 |
|
global verbose |
83 |
|
global MU_TOOL |
84 |
|
global MU_TOOL_FLAGS |
85 |
|
global expect_out |
86 |
|
|
87 |
|
mu_version |
88 |
|
|
89 |
|
set args [lindex $args 0] |
90 |
|
if [info exists MU_TOOL_FLAGS] { |
91 |
|
set sw $MU_TOOL_FLAGS |
92 |
|
} else { |
93 |
|
set sw "" |
94 |
|
} |
95 |
|
|
96 |
|
if [llength $args] { |
97 |
|
append sw $args |
98 |
|
} |
99 |
|
|
100 |
|
if [info exists host_board] { |
101 |
|
if [board_info $host_board exists top_srcdir] { |
102 |
|
append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool" |
103 |
|
} |
104 |
|
} |
105 |
|
|
106 |
|
set cmd "$MU_TOOL $sw" |
107 |
|
verbose "Spawning $cmd" |
108 |
|
|
109 |
|
set res [remote_spawn host $cmd] |
110 |
|
if { $res < 0 || $res == "" } { |
111 |
|
perror "Spawning $cmd failed." |
112 |
|
return 1; |
113 |
|
} |
114 |
|
|
115 |
|
return 0 |
116 |
|
} |
117 |
|
|
118 |
|
# mu_exec [-retcode N][-message S][-default (FAIL | XFAIL)][-arg S...] |
119 |
|
# [PATTERN...] |
120 |
|
# |
121 |
|
# Executes $MU_TOOL and checks whether it returns with the given exit status |
122 |
|
# and its output matches supplied PATTERN. |
123 |
|
# Switches: |
124 |
|
# -retcode N Expect program to finish with exit code N instead of the |
125 |
|
# default 0 (search for word 'Pity' below, though). |
126 |
|
# -arg S Supply additional arguments to the program. |
127 |
|
# -message S Set message to output when printing results of the test. |
128 |
|
# -default Supply the expected testcase result |
129 |
|
proc mu_exec {args} { |
130 |
|
global verbose |
131 |
|
global MU_TOOL |
132 |
|
global MU_TOOL_FLAGS |
133 |
|
global expect_out |
134 |
|
|
135 |
|
mu_version |
136 |
|
|
137 |
|
if [info exists MU_TOOL_FLAGS] { |
138 |
|
set sw $MU_TOOL_FLAGS |
139 |
|
} else { |
140 |
|
set sw "" |
141 |
|
} |
142 |
|
|
143 |
|
set default 0 |
144 |
|
set message "" |
145 |
|
set result 0 |
146 |
|
set retcode 0 |
147 |
|
for {set i 0} {$i < [llength $args]} {incr i} { |
148 |
|
set opt [lindex $args $i] |
149 |
|
if {"$opt" == "-retcode"} { |
150 |
|
set retcode [lindex $args [expr $i + 1]] |
151 |
|
incr i |
152 |
|
} elseif {"$opt" == "-message"} { |
153 |
|
set message [lindex $args [expr $i + 1]] |
154 |
|
incr i |
155 |
|
} elseif {"$opt" == "-default"} { |
156 |
|
set default [lindex $args [expr $i + 1]] |
157 |
|
incr i |
158 |
|
} elseif {"$opt" == "-arg"} { |
159 |
|
append sw " [lindex $args [expr $i + 1]]" |
160 |
|
incr i |
161 |
|
} else { |
162 |
|
break |
163 |
|
} |
164 |
|
} |
165 |
|
|
166 |
|
set args [lrange $args $i end] |
167 |
|
|
168 |
|
if [info exists host_board] { |
169 |
|
if [board_info $host_board exists top_srcdir] { |
170 |
|
append sw " --mail-spool [board_info $host_board top_srcdir]/mail/testsuite/spool" |
171 |
|
} |
172 |
|
} |
173 |
|
|
174 |
|
# Pity, dejagnu provides no way to retrieve exit status of the process. |
175 |
|
# This ugli construction is used to work around this. Hopefully, it |
176 |
|
# should execute on any decent platform... |
177 |
|
set cmd "sh -c \"$MU_TOOL $sw\; echo \$?\"" |
178 |
|
verbose "Executing $cmd" |
179 |
|
|
180 |
|
set res [remote_exec host $cmd] |
181 |
|
|
182 |
|
set args [concat $args "$retcode"] |
183 |
|
|
184 |
|
set output [lindex $res 1] |
185 |
|
|
186 |
|
if {[llength $args] == 0 && [string length $output] != 0} { |
187 |
|
verbose "Expected \"[lindex $args 1]\" but founf EOF" 1 |
188 |
|
set result 1 |
189 |
|
} |
190 |
|
|
191 |
|
for {set i 0} {$result == 0 && $i < [llength $args]} {incr i} { |
192 |
|
if {[string length $output] == 0} { |
193 |
|
verbose "Not enough output from $cmd" 1 |
194 |
|
verbose "Stopped waiting for \"[lindex $args $i]\"" 1 |
195 |
|
set result 1 |
196 |
|
break |
197 |
|
} |
198 |
|
set regexp 0 |
199 |
|
|
200 |
|
switch -regexp -- "[lindex $args $i]" { |
201 |
|
^-re { set regexp 1; incr i } |
202 |
|
^-ex - |
203 |
|
^-- { incr i } |
204 |
|
} |
205 |
|
|
206 |
|
set pattern [lindex $args $i] |
207 |
|
verbose "PATTERN $pattern" |
208 |
|
|
209 |
|
if {$regexp} { |
210 |
|
verbose "does \"$output\" match regular expression \"$pattern\"?" 1 |
211 |
|
if {![regexp -- "$pattern(.*)" "$output" dummy output]} { |
212 |
|
set result 1 |
213 |
|
} |
214 |
|
} else { |
215 |
|
verbose "does \"$output\" match exact string \"$pattern\"?" 1 |
216 |
|
if {"$pattern" != ""} { |
217 |
|
if {[string first "$pattern" "$output"] != 0} { |
218 |
|
set result 1 |
219 |
|
} |
220 |
|
set output [string range $output [string length $pattern] end] |
221 |
|
} |
222 |
|
if {![regexp -- "\[ \t]*\r\n(.*)" "$output" dummy output]} { |
223 |
|
set result 1 |
224 |
|
} |
225 |
|
} |
226 |
|
|
227 |
|
if {$result} { |
228 |
|
verbose "NO" 1 |
229 |
|
} else { |
230 |
|
verbose "yes" 1 |
231 |
|
} |
232 |
|
} |
233 |
|
|
234 |
|
if {$result == 0} { |
235 |
|
pass "$message" |
236 |
|
} elseif {$result == 1} { |
237 |
|
if { "$default" == "" || "$default" != "FAIL" } { |
238 |
|
fail "$message" |
239 |
|
} else { |
240 |
|
xfail "$message" |
241 |
|
set result 0 |
242 |
|
} |
243 |
|
} elseif {$result == -2} { |
244 |
|
fail "$message (timeout)" |
245 |
|
} elseif {$result == -3} { |
246 |
|
fail "$message (eof)" |
247 |
|
} else { |
248 |
|
fail "$message" |
249 |
|
} |
250 |
|
|
251 |
|
return $result |
252 |
|
} |
253 |
|
|
254 |
### Only procedures should come after this point. |
### Only procedures should come after this point. |
255 |
|
|
256 |
proc mu_prepare_spools {} { |
proc mu_prepare_spools {} { |
479 |
} |
} |
480 |
|
|
481 |
# mu_test COMMAND PATTERN |
# mu_test COMMAND PATTERN |
482 |
# COMMAND - Command to send to mail |
# COMMAND - Command to send to the program |
483 |
# PATTERN - A list of strings to expect in return |
# PATTERN - A list of strings to expect in return |
484 |
# Return value: |
# Return value: |
485 |
# -3 - eof |
# -3 - eof |