1# 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.]
6set sim_path "unknown-run"
7
8# Initialize the testrun.
9# Required by dejagnu.
10
11proc 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
21proc 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
30proc 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
61proc 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)]: <assembler options>
162# ld[(mach-list)]: <linker options>
163# sim[(mach-list)]: <simulator options>
164# output: program output pattern to match with string-match
165# xerror: program is expected to return with a "failure" exit code
166# xfail: <PRMS-opt> <target-triplets-where-test-fails>
167# kfail: <PRMS> <target-triplets-where-test-fails>
168# If `output' is not specified, the program must output "pass" if !xerror or
169# "fail" if xerror.
170# The parens in "optname()" are optional if the specification is for all machs.
171# Multiple "output", "xfail" and "kfail" options concatenate.
172# The xfail and kfail arguments are space-separated target triplets and PRIDs.
173# There must be a PRMS (bug report ID) specified for kfail, while it's
174# optional for xfail.
175
176proc run_sim_test { name requested_machs } {
177    global subdir srcdir
178    global SIMFLAGS
179    global opts
180    global cpu_option
181    global global_as_options
182    global global_ld_options
183    global global_sim_options
184
185    if [string match "*/*" $name] {
186	set file $name
187	set name [file tail $name]
188    } else {
189	set file "$srcdir/$subdir/$name"
190    }
191
192    set opt_array [slurp_options "${file}"]
193    if { $opt_array == -1 } {
194	unresolved $subdir/$name
195	return
196    }
197    # Clear default options
198    set opts(as) ""
199    set opts(ld) ""
200    set opts(sim) ""
201    set opts(output) ""
202    set opts(mach) ""
203    set opts(timeout) ""
204    set opts(xerror) "no"
205    set opts(xfail) ""
206    set opts(kfail) ""
207
208    if ![info exists global_as_options] {
209        set global_as_options ""
210    }
211    if ![info exists global_ld_options] {
212        set global_ld_options ""
213    }
214    if ![info exists global_sim_options] {
215        set global_sim_options ""
216    }
217
218    # Clear any machine specific options specified in a previous test case
219    foreach m $requested_machs {
220	if [info exists opts(as,$m)] {
221	    unset opts(as,$m)
222	}
223	if [info exists opts(ld,$m)] {
224	    unset opts(ld,$m)
225	}
226	if [info exists opts(sim,$m)] {
227	    unset opts(sim,$m)
228	}
229    }
230
231    foreach i $opt_array {
232	set opt_name [lindex $i 0]
233	set opt_machs [lindex $i 1]
234	set opt_val [lindex $i 2]
235	if ![info exists opts($opt_name)] {
236	    perror "unknown option $opt_name in file $file"
237	    unresolved $subdir/$name
238	    return
239	}
240	# Multiple "output" specifications concatenate, they don't override.
241	if { $opt_name == "output" } {
242	    set opt_val "$opts(output)$opt_val"
243	}
244	# Similar with "xfail" and "kfail", but arguments are space-separated.
245	if { $opt_name == "xfail" || $opt_name == "kfail" } {
246	    set opt_val "$opts($opt_name) $opt_val"
247	}
248
249	foreach m $opt_machs {
250	    set opts($opt_name,$m) $opt_val
251	}
252	if { "$opt_machs" == "" } {
253	    set opts($opt_name) $opt_val
254	}
255    }
256
257    set testname $name
258    set sourcefile $file
259    if { $opts(output) == "" } {
260	if { "$opts(xerror)" == "no" } {
261	    set opts(output) "pass\n"
262	} else {
263	    set opts(output) "fail\n"
264	}
265    }
266    # Change \n sequences to newline chars.
267    regsub -all "\\\\n" $opts(output) "\n" opts(output)
268
269    set testcase_machs $opts(mach)
270    if { "$testcase_machs" == "all" } {
271	set testcase_machs $requested_machs
272    }
273
274    foreach mach $testcase_machs {
275	if { [lsearch $requested_machs $mach] < 0 } {
276	    verbose -log "Skipping $mach version of $name, not requested."
277	    continue
278	}
279
280	verbose -log "Testing $name on machine $mach."
281
282	# Time to setup xfailures and kfailures.
283	if { "$opts(xfail)" != "" } {
284	    verbose -log "xfail: $opts(xfail)"
285	    # Using eval to make $opts(xfail) appear as individual
286	    # arguments.
287	    eval setup_xfail $opts(xfail)
288	}
289	if { "$opts(kfail)" != "" } {
290	    verbose -log "kfail: $opts(kfail)"
291	    eval setup_kfail $opts(kfail)
292	}
293
294	if ![info exists opts(as,$mach)] {
295	    set opts(as,$mach) $opts(as)
296	}
297
298	set as_options "$opts(as,$mach) -I$srcdir/$subdir"
299	if [info exists cpu_option] {
300	    set as_options "$as_options $cpu_option=$mach"
301	}
302	set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
303
304	if ![string match "" $comp_output] {
305	    verbose -log "$comp_output" 3
306	    fail "$mach $testname (assembling)"
307	    continue
308	}
309
310	if ![info exists opts(ld,$mach)] {
311	    set opts(ld,$mach) $opts(ld)
312	}
313
314	set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
315
316	if ![string match "" $comp_output] {
317	    verbose -log "$comp_output" 3
318	    fail "$mach $testname (linking)"
319	    continue
320	}
321
322	# If no machine specific options, default to the general version.
323	if ![info exists opts(sim,$mach)] {
324	    set opts(sim,$mach) $opts(sim)
325	}
326
327	# Build the options argument.
328	set options ""
329	if { "$opts(timeout)" != "" } {
330	    set options "$options timeout=$opts(timeout)"
331	}
332
333	set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "" "" "$options"]
334	set status [lindex $result 0]
335	set output [lindex $result 1]
336
337	if { "$status" == "pass" } {
338	    if { "$opts(xerror)" == "no" } {
339		if [string match $opts(output) $output] {
340		    pass "$mach $testname"
341		    file delete ${name}.o ${name}.x
342		} else {
343		    verbose -log "output:  $output" 3
344		    verbose -log "pattern: $opts(output)" 3
345		    fail "$mach $testname (execution)"
346		}
347	    } else {
348		verbose -log "`pass' return code when expecting failure" 3
349		fail "$mach $testname (execution)"
350	    }
351	} elseif { "$status" == "fail" } {
352	    if { "$opts(xerror)" == "no" } {
353		fail "$mach $testname (execution)"
354	    } else {
355		if [string match $opts(output) $output] {
356		    pass "$mach $testname"
357		    file delete ${name}.o ${name}.x
358		} else {
359		    verbose -log "output:  $output" 3
360		    verbose -log "pattern: $opts(output)" 3
361		    fail "$mach $testname (execution)"
362		}
363	    }
364	} else {
365	    $status "$mach $testname"
366	}
367    }
368}
369
370# Subroutine of run_sim_test to process options in FILE.
371
372proc slurp_options { file } {
373    if [catch { set f [open $file r] } x] {
374	#perror "couldn't open `$file': $x"
375	perror "$x"
376	return -1
377    }
378    set opt_array {}
379    # whitespace expression
380    set ws  {[ 	]*}
381    set nws {[^ 	]*}
382    # whitespace is ignored anywhere except within the options list;
383    # option names are alphabetic only
384    set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
385    # Allow arbitrary lines until the first option is seen.
386    set seen_opt 0
387    while { [gets $f line] != -1 } {
388	set line [string trim $line]
389	# Whitespace here is space-tab.
390	if [regexp $pat $line xxx opt_name opt_machs opt_val] {
391	    # match!
392	    lappend opt_array [list $opt_name $opt_machs $opt_val]
393	    set seen_opt 1
394	} else {
395	    if { $seen_opt } {
396		break
397	    }
398	}
399    }
400    close $f
401    return $opt_array
402}
403