1 |
227 |
jeremybenn |
# Simulator dejagnu utilities.
|
2 |
|
|
|
3 |
|
|
# Communicate simulator path from sim_init to sim_version.
|
4 |
|
|
# For some reason [board_info target sim] doesn't work in sim_version.
|
5 |
|
|
# [Presumubly because the target has been "popped" by then. Odd though.]
|
6 |
|
|
set sim_path "unknown-run"
|
7 |
|
|
|
8 |
|
|
# Initialize the testrun.
|
9 |
|
|
# Required by dejagnu.
|
10 |
|
|
|
11 |
|
|
proc sim_init { args } {
|
12 |
|
|
global sim_path
|
13 |
|
|
set sim_path [board_info target sim]
|
14 |
|
|
# Need to return an empty string (copied from GAS).
|
15 |
|
|
return ""
|
16 |
|
|
}
|
17 |
|
|
|
18 |
|
|
# Print the version of the simulator being tested.
|
19 |
|
|
# Required by dejagnu.
|
20 |
|
|
|
21 |
|
|
proc sim_version {} {
|
22 |
|
|
global sim_path
|
23 |
|
|
set version 0.5
|
24 |
|
|
clone_output "$sim_path $version\n"
|
25 |
|
|
}
|
26 |
|
|
|
27 |
|
|
# Cover function to target_compile.
|
28 |
|
|
# Copied from gdb_compile.
|
29 |
|
|
|
30 |
|
|
proc sim_compile { source dest type options } {
|
31 |
|
|
set result [target_compile $source $dest $type $options]
|
32 |
|
|
regsub "\[\r\n\]*$" "$result" "" result
|
33 |
|
|
regsub "^\[\r\n\]*" "$result" "" result
|
34 |
|
|
if { $result != "" } {
|
35 |
|
|
clone_output "sim compile output: $result"
|
36 |
|
|
}
|
37 |
|
|
return $result
|
38 |
|
|
}
|
39 |
|
|
|
40 |
|
|
# Run a program on the simulator.
|
41 |
|
|
# Required by dejagnu (at least ${tool}_run used to be).
|
42 |
|
|
#
|
43 |
|
|
# SIM_OPTS are options for the simulator.
|
44 |
|
|
# PROG_OPTS are options passed to the simulated program.
|
45 |
|
|
# At present REDIR must be "" or "> foo".
|
46 |
|
|
# OPTIONS is a list of options internal to this routine.
|
47 |
|
|
# This is modelled after target_compile. We want to be able to add new
|
48 |
|
|
# options without having to update all our users.
|
49 |
|
|
# Currently:
|
50 |
|
|
# env(foo)=val - set environment variable foo to val for this run
|
51 |
|
|
# timeout=val - set the timeout to val for this run
|
52 |
|
|
#
|
53 |
|
|
# The result is a list of two elements.
|
54 |
|
|
# The first is one of pass/fail/etc.
|
55 |
|
|
# The second is the program's output.
|
56 |
|
|
#
|
57 |
|
|
# This is different than the sim_load routine provided by
|
58 |
|
|
# dejagnu/config/sim.exp. It's not clear how to pass arguments to the
|
59 |
|
|
# simulator (not the simulated program, the simulator) with sim_load.
|
60 |
|
|
|
61 |
|
|
proc sim_run { prog sim_opts prog_opts redir options } {
|
62 |
|
|
global SIMFLAGS
|
63 |
|
|
|
64 |
|
|
# Set the default value of the timeout.
|
65 |
|
|
# FIXME: The timeout value we actually want is a function of
|
66 |
|
|
# host, target, and testcase.
|
67 |
|
|
set testcase_timeout [board_info target sim_time_limit]
|
68 |
|
|
if { "$testcase_timeout" == "" } {
|
69 |
|
|
set testcase_timeout [board_info host testcase_timeout]
|
70 |
|
|
}
|
71 |
|
|
if { "$testcase_timeout" == "" } {
|
72 |
|
|
set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp.
|
73 |
|
|
}
|
74 |
|
|
|
75 |
|
|
# Initial the environment we pass to the testcase.
|
76 |
|
|
set testcase_env ""
|
77 |
|
|
|
78 |
|
|
# Process OPTIONS ...
|
79 |
|
|
foreach o $options {
|
80 |
|
|
if [regexp {^env\((.*)\)=(.*)} $o full var val] {
|
81 |
|
|
set testcase_env "$testcase_env $var=$val"
|
82 |
|
|
} elseif [regexp {^timeout=(.*)} $o full val] {
|
83 |
|
|
set testcase_timeout $val
|
84 |
|
|
}
|
85 |
|
|
|
86 |
|
|
}
|
87 |
|
|
|
88 |
|
|
verbose "testcase timeout is set to $testcase_timeout" 1
|
89 |
|
|
|
90 |
|
|
set sim [board_info target sim]
|
91 |
|
|
|
92 |
|
|
if [is_remote host] {
|
93 |
|
|
set prog [remote_download host $prog]
|
94 |
|
|
if { $prog == "" } {
|
95 |
|
|
error "download failed"
|
96 |
|
|
return -1
|
97 |
|
|
}
|
98 |
|
|
}
|
99 |
|
|
|
100 |
|
|
set board [target_info name]
|
101 |
|
|
if [board_info $board exists sim,options] {
|
102 |
|
|
set always_opts [board_info $board sim,options]
|
103 |
|
|
} else {
|
104 |
|
|
set always_opts ""
|
105 |
|
|
}
|
106 |
|
|
|
107 |
|
|
# FIXME: this works for UNIX only
|
108 |
|
|
if { "$testcase_env" != "" } {
|
109 |
|
|
set sim "env $testcase_env $sim"
|
110 |
|
|
}
|
111 |
|
|
|
112 |
|
|
if { [board_info target sim,protocol] == "sid" } {
|
113 |
|
|
set cmd ""
|
114 |
|
|
set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\""
|
115 |
|
|
} else {
|
116 |
|
|
set cmd "$prog"
|
117 |
|
|
}
|
118 |
|
|
|
119 |
|
|
send_log "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts\n"
|
120 |
|
|
|
121 |
|
|
if { "$redir" == "" } {
|
122 |
|
|
remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts"
|
123 |
|
|
} else {
|
124 |
|
|
remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts $redir" writeonly
|
125 |
|
|
}
|
126 |
|
|
set result [remote_wait host $testcase_timeout]
|
127 |
|
|
|
128 |
|
|
set return_code [lindex $result 0]
|
129 |
|
|
set output [lindex $result 1]
|
130 |
|
|
# Remove the \r part of "\r\n" so we don't break all the patterns
|
131 |
|
|
# we want to match.
|
132 |
|
|
regsub -all -- "\r" $output "" output
|
133 |
|
|
|
134 |
|
|
if [is_remote host] {
|
135 |
|
|
# clean up after ourselves.
|
136 |
|
|
remote_file host delete $prog
|
137 |
|
|
}
|
138 |
|
|
|
139 |
|
|
# ??? Not sure the test for pass/fail is right.
|
140 |
|
|
# We just care that the simulator ran correctly, not whether the simulated
|
141 |
|
|
# program return 0 or non-zero from `main'.
|
142 |
|
|
set status fail
|
143 |
|
|
if { $return_code == 0 } {
|
144 |
|
|
set status pass
|
145 |
|
|
}
|
146 |
|
|
|
147 |
|
|
return [list $status $output]
|
148 |
|
|
}
|
149 |
|
|
|
150 |
|
|
# Run testcase NAME.
|
151 |
|
|
# NAME is either a fully specified file name, or just the file name in which
|
152 |
|
|
# case $srcdir/$subdir will be prepended.
|
153 |
|
|
# REQUESTED_MACHS is a list of machines to run the testcase on. If NAME isn't
|
154 |
|
|
# for the specified machine(s), it is ignored.
|
155 |
|
|
# Typically REQUESTED_MACHS contains just one element, it is up to the caller
|
156 |
|
|
# to iterate over the desired machine variants.
|
157 |
|
|
#
|
158 |
|
|
# The file can contain options in the form "# option(mach list): value".
|
159 |
|
|
# Possibilities:
|
160 |
|
|
# mach: [all | machine names]
|
161 |
|
|
# as[(mach-list)]:
|
162 |
|
|
# ld[(mach-list)]:
|
163 |
|
|
# sim[(mach-list)]:
|
164 |
|
|
# progopts:
|
165 |
|
|
# output: program output pattern to match with string-match
|
166 |
|
|
# xerror: program is expected to return with a "failure" exit code
|
167 |
|
|
# xfail:
|
168 |
|
|
# kfail:
|
169 |
|
|
# If `output' is not specified, the program must output "pass" if !xerror or
|
170 |
|
|
# "fail" if xerror.
|
171 |
|
|
# The parens in "optname()" are optional if the specification is for all machs.
|
172 |
|
|
# Multiple "output", "xfail" and "kfail" options concatenate.
|
173 |
|
|
# The xfail and kfail arguments are space-separated target triplets and PRIDs.
|
174 |
|
|
# There must be a PRMS (bug report ID) specified for kfail, while it's
|
175 |
|
|
# optional for xfail.
|
176 |
|
|
|
177 |
|
|
proc run_sim_test { name requested_machs } {
|
178 |
|
|
global subdir srcdir
|
179 |
|
|
global SIMFLAGS
|
180 |
|
|
global opts
|
181 |
|
|
global cpu_option
|
182 |
|
|
global global_as_options
|
183 |
|
|
global global_ld_options
|
184 |
|
|
global global_sim_options
|
185 |
|
|
|
186 |
|
|
if [string match "*/*" $name] {
|
187 |
|
|
set file $name
|
188 |
|
|
set name [file tail $name]
|
189 |
|
|
} else {
|
190 |
|
|
set file "$srcdir/$subdir/$name"
|
191 |
|
|
}
|
192 |
|
|
|
193 |
|
|
set opt_array [slurp_options "${file}"]
|
194 |
|
|
if { $opt_array == -1 } {
|
195 |
|
|
unresolved $subdir/$name
|
196 |
|
|
return
|
197 |
|
|
}
|
198 |
|
|
# Clear default options
|
199 |
|
|
set opts(as) ""
|
200 |
|
|
set opts(ld) ""
|
201 |
|
|
set opts(progopts) ""
|
202 |
|
|
set opts(sim) ""
|
203 |
|
|
set opts(output) ""
|
204 |
|
|
set opts(mach) ""
|
205 |
|
|
set opts(timeout) ""
|
206 |
|
|
set opts(xerror) "no"
|
207 |
|
|
set opts(xfail) ""
|
208 |
|
|
set opts(kfail) ""
|
209 |
|
|
|
210 |
|
|
if ![info exists global_as_options] {
|
211 |
|
|
set global_as_options ""
|
212 |
|
|
}
|
213 |
|
|
if ![info exists global_ld_options] {
|
214 |
|
|
set global_ld_options ""
|
215 |
|
|
}
|
216 |
|
|
if ![info exists global_sim_options] {
|
217 |
|
|
set global_sim_options ""
|
218 |
|
|
}
|
219 |
|
|
|
220 |
|
|
# Clear any machine specific options specified in a previous test case
|
221 |
|
|
foreach m $requested_machs {
|
222 |
|
|
if [info exists opts(as,$m)] {
|
223 |
|
|
unset opts(as,$m)
|
224 |
|
|
}
|
225 |
|
|
if [info exists opts(ld,$m)] {
|
226 |
|
|
unset opts(ld,$m)
|
227 |
|
|
}
|
228 |
|
|
if [info exists opts(sim,$m)] {
|
229 |
|
|
unset opts(sim,$m)
|
230 |
|
|
}
|
231 |
|
|
}
|
232 |
|
|
|
233 |
|
|
foreach i $opt_array {
|
234 |
|
|
set opt_name [lindex $i 0]
|
235 |
|
|
set opt_machs [lindex $i 1]
|
236 |
|
|
set opt_val [lindex $i 2]
|
237 |
|
|
if ![info exists opts($opt_name)] {
|
238 |
|
|
perror "unknown option $opt_name in file $file"
|
239 |
|
|
unresolved $subdir/$name
|
240 |
|
|
return
|
241 |
|
|
}
|
242 |
|
|
# Multiple "output" specifications concatenate, they don't override.
|
243 |
|
|
if { $opt_name == "output" } {
|
244 |
|
|
set opt_val "$opts(output)$opt_val"
|
245 |
|
|
}
|
246 |
|
|
# Similar with "xfail" and "kfail", but arguments are space-separated.
|
247 |
|
|
if { $opt_name == "xfail" || $opt_name == "kfail" } {
|
248 |
|
|
set opt_val "$opts($opt_name) $opt_val"
|
249 |
|
|
}
|
250 |
|
|
|
251 |
|
|
foreach m $opt_machs {
|
252 |
|
|
set opts($opt_name,$m) $opt_val
|
253 |
|
|
}
|
254 |
|
|
if { "$opt_machs" == "" } {
|
255 |
|
|
set opts($opt_name) $opt_val
|
256 |
|
|
}
|
257 |
|
|
}
|
258 |
|
|
|
259 |
|
|
set testname $name
|
260 |
|
|
set sourcefile $file
|
261 |
|
|
if { $opts(output) == "" } {
|
262 |
|
|
if { "$opts(xerror)" == "no" } {
|
263 |
|
|
set opts(output) "pass\n"
|
264 |
|
|
} else {
|
265 |
|
|
set opts(output) "fail\n"
|
266 |
|
|
}
|
267 |
|
|
}
|
268 |
|
|
# Change \n sequences to newline chars.
|
269 |
|
|
regsub -all "\\\\n" $opts(output) "\n" opts(output)
|
270 |
|
|
|
271 |
|
|
set testcase_machs $opts(mach)
|
272 |
|
|
if { "$testcase_machs" == "all" } {
|
273 |
|
|
set testcase_machs $requested_machs
|
274 |
|
|
}
|
275 |
|
|
|
276 |
|
|
foreach mach $testcase_machs {
|
277 |
|
|
if { [lsearch $requested_machs $mach] < 0 } {
|
278 |
|
|
verbose -log "Skipping $mach version of $name, not requested."
|
279 |
|
|
continue
|
280 |
|
|
}
|
281 |
|
|
|
282 |
|
|
verbose -log "Testing $name on machine $mach."
|
283 |
|
|
|
284 |
|
|
# Time to setup xfailures and kfailures.
|
285 |
|
|
if { "$opts(xfail)" != "" } {
|
286 |
|
|
verbose -log "xfail: $opts(xfail)"
|
287 |
|
|
# Using eval to make $opts(xfail) appear as individual
|
288 |
|
|
# arguments.
|
289 |
|
|
eval setup_xfail $opts(xfail)
|
290 |
|
|
}
|
291 |
|
|
if { "$opts(kfail)" != "" } {
|
292 |
|
|
verbose -log "kfail: $opts(kfail)"
|
293 |
|
|
eval setup_kfail $opts(kfail)
|
294 |
|
|
}
|
295 |
|
|
|
296 |
|
|
if ![info exists opts(as,$mach)] {
|
297 |
|
|
set opts(as,$mach) $opts(as)
|
298 |
|
|
}
|
299 |
|
|
|
300 |
|
|
set as_options "$opts(as,$mach) -I$srcdir/$subdir"
|
301 |
|
|
if [info exists cpu_option] {
|
302 |
|
|
set as_options "$as_options $cpu_option=$mach"
|
303 |
|
|
}
|
304 |
|
|
set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
|
305 |
|
|
|
306 |
|
|
if ![string match "" $comp_output] {
|
307 |
|
|
verbose -log "$comp_output" 3
|
308 |
|
|
fail "$mach $testname (assembling)"
|
309 |
|
|
continue
|
310 |
|
|
}
|
311 |
|
|
|
312 |
|
|
if ![info exists opts(ld,$mach)] {
|
313 |
|
|
set opts(ld,$mach) $opts(ld)
|
314 |
|
|
}
|
315 |
|
|
|
316 |
|
|
set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
|
317 |
|
|
|
318 |
|
|
if ![string match "" $comp_output] {
|
319 |
|
|
verbose -log "$comp_output" 3
|
320 |
|
|
fail "$mach $testname (linking)"
|
321 |
|
|
continue
|
322 |
|
|
}
|
323 |
|
|
|
324 |
|
|
# If no machine specific options, default to the general version.
|
325 |
|
|
if ![info exists opts(sim,$mach)] {
|
326 |
|
|
set opts(sim,$mach) $opts(sim)
|
327 |
|
|
}
|
328 |
|
|
|
329 |
|
|
# Build the options argument.
|
330 |
|
|
set options ""
|
331 |
|
|
if { "$opts(timeout)" != "" } {
|
332 |
|
|
set options "$options timeout=$opts(timeout)"
|
333 |
|
|
}
|
334 |
|
|
|
335 |
|
|
set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "$opts(progopts)" "" "$options"]
|
336 |
|
|
set status [lindex $result 0]
|
337 |
|
|
set output [lindex $result 1]
|
338 |
|
|
|
339 |
|
|
if { "$status" == "pass" } {
|
340 |
|
|
if { "$opts(xerror)" == "no" } {
|
341 |
|
|
if [string match $opts(output) $output] {
|
342 |
|
|
pass "$mach $testname"
|
343 |
|
|
file delete ${name}.o ${name}.x
|
344 |
|
|
} else {
|
345 |
|
|
verbose -log "output: $output" 3
|
346 |
|
|
verbose -log "pattern: $opts(output)" 3
|
347 |
|
|
fail "$mach $testname (execution)"
|
348 |
|
|
}
|
349 |
|
|
} else {
|
350 |
|
|
verbose -log "`pass' return code when expecting failure" 3
|
351 |
|
|
fail "$mach $testname (execution)"
|
352 |
|
|
}
|
353 |
|
|
} elseif { "$status" == "fail" } {
|
354 |
|
|
if { "$opts(xerror)" == "no" } {
|
355 |
|
|
fail "$mach $testname (execution)"
|
356 |
|
|
} else {
|
357 |
|
|
if [string match $opts(output) $output] {
|
358 |
|
|
pass "$mach $testname"
|
359 |
|
|
file delete ${name}.o ${name}.x
|
360 |
|
|
} else {
|
361 |
|
|
verbose -log "output: $output" 3
|
362 |
|
|
verbose -log "pattern: $opts(output)" 3
|
363 |
|
|
fail "$mach $testname (execution)"
|
364 |
|
|
}
|
365 |
|
|
}
|
366 |
|
|
} else {
|
367 |
|
|
$status "$mach $testname"
|
368 |
|
|
}
|
369 |
|
|
}
|
370 |
|
|
}
|
371 |
|
|
|
372 |
|
|
# Subroutine of run_sim_test to process options in FILE.
|
373 |
|
|
|
374 |
|
|
proc slurp_options { file } {
|
375 |
|
|
if [catch { set f [open $file r] } x] {
|
376 |
|
|
#perror "couldn't open `$file': $x"
|
377 |
|
|
perror "$x"
|
378 |
|
|
return -1
|
379 |
|
|
}
|
380 |
|
|
set opt_array {}
|
381 |
|
|
# whitespace expression
|
382 |
|
|
set ws {[ ]*}
|
383 |
|
|
set nws {[^ ]*}
|
384 |
|
|
# whitespace is ignored anywhere except within the options list;
|
385 |
|
|
# option names are alphabetic only
|
386 |
|
|
set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
|
387 |
|
|
# Allow arbitrary lines until the first option is seen.
|
388 |
|
|
set seen_opt 0
|
389 |
|
|
while { [gets $f line] != -1 } {
|
390 |
|
|
set line [string trim $line]
|
391 |
|
|
# Whitespace here is space-tab.
|
392 |
|
|
if [regexp $pat $line xxx opt_name opt_machs opt_val] {
|
393 |
|
|
# match!
|
394 |
|
|
lappend opt_array [list $opt_name $opt_machs $opt_val]
|
395 |
|
|
set seen_opt 1
|
396 |
|
|
} else {
|
397 |
|
|
if { $seen_opt } {
|
398 |
|
|
break
|
399 |
|
|
}
|
400 |
|
|
}
|
401 |
|
|
}
|
402 |
|
|
close $f
|
403 |
|
|
return $opt_array
|
404 |
|
|
}
|