xref: /netbsd-src/external/gpl3/gdb/dist/sim/testsuite/lib/sim-defs.exp (revision 7d3af8c6a2070d16ec6d1aef203d052d6683100d)
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    if [string equal "" $sim] {
92	# Special case the simulator.  These tests are designed to
93	# be run inside of the simulator, not on the native host.
94	# So if the sim target isn't set, default to the target run.
95	# These global variables come from generated site.exp.
96	global objdir
97	global arch
98	set sim "$objdir/../$arch/run"
99    }
100
101    if [is_remote host] {
102	set prog [remote_download host $prog]
103	if { $prog == "" } {
104	    error "download failed"
105	    return -1
106	}
107    }
108
109    set board [target_info name]
110    if [board_info $board exists sim,options] {
111	set always_opts [board_info $board sim,options]
112    } else {
113	set always_opts ""
114    }
115
116    # FIXME: this works for UNIX only
117    if { "$testcase_env" != "" } {
118	set sim "env $testcase_env $sim"
119    }
120
121    if { [board_info target sim,protocol] == "sid" } {
122	set cmd ""
123	set sim_opts "$sim_opts -e \"set cpu-loader file [list ${prog}]\""
124    } else {
125	set cmd "$prog"
126    }
127
128    send_log "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts\n"
129
130    if { "$redir" == "" } {
131	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts"
132    } else {
133	remote_spawn host "$sim $always_opts $SIMFLAGS $sim_opts $cmd $prog_opts $redir" writeonly
134    }
135    set result [remote_wait host $testcase_timeout]
136
137    set return_code [lindex $result 0]
138    set output [lindex $result 1]
139    # Remove the \r part of "\r\n" so we don't break all the patterns
140    # we want to match.
141    regsub -all -- "\r" $output "" output
142
143    if [is_remote host] {
144	# clean up after ourselves.
145	remote_file host delete $prog
146    }
147
148    # ??? Not sure the test for pass/fail is right.
149    # We just care that the simulator ran correctly, not whether the simulated
150    # program return 0 or non-zero from `main'.
151    set status fail
152    if { $return_code == 0 } {
153	set status pass
154    }
155
156    return [list $status $output]
157}
158
159# Run testcase NAME.
160# NAME is either a fully specified file name, or just the file name in which
161# case $srcdir/$subdir will be prepended.
162# REQUESTED_MACHS is a list of machines to run the testcase on.  If NAME isn't
163# for the specified machine(s), it is ignored.
164# Typically REQUESTED_MACHS contains just one element, it is up to the caller
165# to iterate over the desired machine variants.
166#
167# The file can contain options in the form "# option(mach list): value".
168# Possibilities:
169# mach: [all | machine names]
170# as[(mach-list)]: <assembler options>
171# ld[(mach-list)]: <linker options>
172# sim[(mach-list)]: <simulator options>
173# progopts: <arguments to the program being simulated>
174# output: program output pattern to match with string-match
175# xerror: program is expected to return with a "failure" exit code
176# xfail: <PRMS-opt> <target-triplets-where-test-fails>
177# kfail: <PRMS> <target-triplets-where-test-fails>
178# If `output' is not specified, the program must output "pass" if !xerror or
179# "fail" if xerror.
180# The parens in "optname()" are optional if the specification is for all machs.
181# Multiple "output", "xfail" and "kfail" options concatenate.
182# The xfail and kfail arguments are space-separated target triplets and PRIDs.
183# There must be a PRMS (bug report ID) specified for kfail, while it's
184# optional for xfail.
185
186proc run_sim_test { name requested_machs } {
187    global subdir srcdir
188    global SIMFLAGS
189    global opts
190    global cpu_option
191    global global_as_options
192    global global_ld_options
193    global global_sim_options
194
195    if [string match "*/*" $name] {
196	set file $name
197	set name [file tail $name]
198    } else {
199	set file "$srcdir/$subdir/$name"
200    }
201
202    set opt_array [slurp_options "${file}"]
203    if { $opt_array == -1 } {
204	unresolved $subdir/$name
205	return
206    }
207    # Clear default options
208    set opts(as) ""
209    set opts(ld) ""
210    set opts(progopts) ""
211    set opts(sim) ""
212    set opts(output) ""
213    set opts(mach) ""
214    set opts(timeout) ""
215    set opts(xerror) "no"
216    set opts(xfail) ""
217    set opts(kfail) ""
218
219    if ![info exists global_as_options] {
220        set global_as_options ""
221    }
222    if ![info exists global_ld_options] {
223        set global_ld_options ""
224    }
225    if ![info exists global_sim_options] {
226        set global_sim_options ""
227    }
228
229    # Clear any machine specific options specified in a previous test case
230    foreach m $requested_machs {
231	if [info exists opts(as,$m)] {
232	    unset opts(as,$m)
233	}
234	if [info exists opts(ld,$m)] {
235	    unset opts(ld,$m)
236	}
237	if [info exists opts(sim,$m)] {
238	    unset opts(sim,$m)
239	}
240    }
241
242    foreach i $opt_array {
243	set opt_name [lindex $i 0]
244	set opt_machs [lindex $i 1]
245	set opt_val [lindex $i 2]
246	if ![info exists opts($opt_name)] {
247	    perror "unknown option $opt_name in file $file"
248	    unresolved $subdir/$name
249	    return
250	}
251	# Multiple "output" specifications concatenate, they don't override.
252	if { $opt_name == "output" } {
253	    set opt_val "$opts(output)$opt_val"
254	}
255	# Similar with "xfail" and "kfail", but arguments are space-separated.
256	if { $opt_name == "xfail" || $opt_name == "kfail" } {
257	    set opt_val "$opts($opt_name) $opt_val"
258	}
259
260	foreach m $opt_machs {
261	    set opts($opt_name,$m) $opt_val
262	}
263	if { "$opt_machs" == "" } {
264	    set opts($opt_name) $opt_val
265	}
266    }
267
268    set testname $name
269    set sourcefile $file
270    if { $opts(output) == "" } {
271	if { "$opts(xerror)" == "no" } {
272	    set opts(output) "pass\n"
273	} else {
274	    set opts(output) "fail\n"
275	}
276    }
277    # Change \n sequences to newline chars.
278    regsub -all "\\\\n" $opts(output) "\n" opts(output)
279
280    set testcase_machs $opts(mach)
281    if { "$testcase_machs" == "all" } {
282	set testcase_machs $requested_machs
283    }
284
285    foreach mach $testcase_machs {
286	if { [lsearch $requested_machs $mach] < 0 } {
287	    verbose -log "Skipping $mach version of $name, not requested."
288	    continue
289	}
290
291	verbose -log "Testing $name on machine $mach."
292
293	# Time to setup xfailures and kfailures.
294	if { "$opts(xfail)" != "" } {
295	    verbose -log "xfail: $opts(xfail)"
296	    # Using eval to make $opts(xfail) appear as individual
297	    # arguments.
298	    eval setup_xfail $opts(xfail)
299	}
300	if { "$opts(kfail)" != "" } {
301	    verbose -log "kfail: $opts(kfail)"
302	    eval setup_kfail $opts(kfail)
303	}
304
305	if ![info exists opts(as,$mach)] {
306	    set opts(as,$mach) $opts(as)
307	}
308
309	set as_options "$opts(as,$mach) -I$srcdir/$subdir"
310	if [info exists cpu_option] {
311	    set as_options "$as_options $cpu_option=$mach"
312	}
313	set comp_output [target_assemble $sourcefile ${name}.o "$as_options $global_as_options"]
314
315	if ![string match "" $comp_output] {
316	    verbose -log "$comp_output" 3
317	    fail "$mach $testname (assembling)"
318	    continue
319	}
320
321	if ![info exists opts(ld,$mach)] {
322	    set opts(ld,$mach) $opts(ld)
323	}
324
325	set comp_output [target_link ${name}.o ${name}.x "$opts(ld,$mach) $global_ld_options"]
326
327	if ![string match "" $comp_output] {
328	    verbose -log "$comp_output" 3
329	    fail "$mach $testname (linking)"
330	    continue
331	}
332
333	# If no machine specific options, default to the general version.
334	if ![info exists opts(sim,$mach)] {
335	    set opts(sim,$mach) $opts(sim)
336	}
337
338	# Build the options argument.
339	set options ""
340	if { "$opts(timeout)" != "" } {
341	    set options "$options timeout=$opts(timeout)"
342	}
343
344	set result [sim_run ${name}.x "$opts(sim,$mach) $global_sim_options" "$opts(progopts)" "" "$options"]
345	set status [lindex $result 0]
346	set output [lindex $result 1]
347
348	if { "$status" == "pass" } {
349	    if { "$opts(xerror)" == "no" } {
350		if [string match $opts(output) $output] {
351		    pass "$mach $testname"
352		    file delete ${name}.o ${name}.x
353		} else {
354		    verbose -log "output:  $output" 3
355		    verbose -log "pattern: $opts(output)" 3
356		    fail "$mach $testname (execution)"
357		}
358	    } else {
359		verbose -log "`pass' return code when expecting failure" 3
360		fail "$mach $testname (execution)"
361	    }
362	} elseif { "$status" == "fail" } {
363	    if { "$opts(xerror)" == "no" } {
364		fail "$mach $testname (execution)"
365	    } else {
366		if [string match $opts(output) $output] {
367		    pass "$mach $testname"
368		    file delete ${name}.o ${name}.x
369		} else {
370		    verbose -log "output:  $output" 3
371		    verbose -log "pattern: $opts(output)" 3
372		    fail "$mach $testname (execution)"
373		}
374	    }
375	} else {
376	    $status "$mach $testname"
377	}
378    }
379}
380
381# Subroutine of run_sim_test to process options in FILE.
382
383proc slurp_options { file } {
384    if [catch { set f [open $file r] } x] {
385	#perror "couldn't open `$file': $x"
386	perror "$x"
387	return -1
388    }
389    set opt_array {}
390    # whitespace expression
391    set ws  {[ 	]*}
392    set nws {[^ 	]*}
393    # whitespace is ignored anywhere except within the options list;
394    # option names are alphabetic only
395    set pat "^#${ws}(\[a-zA-Z\]*)\\(?(\[^):\]*)\\)?$ws:${ws}(.*)$ws\$"
396    # Allow arbitrary lines until the first option is seen.
397    set seen_opt 0
398    while { [gets $f line] != -1 } {
399	set line [string trim $line]
400	# Whitespace here is space-tab.
401	if [regexp $pat $line xxx opt_name opt_machs opt_val] {
402	    # match!
403	    lappend opt_array [list $opt_name $opt_machs $opt_val]
404	    set seen_opt 1
405	} else {
406	    if { $seen_opt } {
407		break
408	    }
409	}
410    }
411    close $f
412    return $opt_array
413}
414