Commit | Line | Data |
---|---|---|
801354e7 DE |
1 | # Simulator dejagnu utilities. |
2 | ||
3 | # Print the version of the simulator being tested. | |
4 | # Required by dejagnu. | |
5 | ||
6 | proc sim_version {} { | |
7 | set version 0.5 | |
8 | set program [board_info target sim] | |
9 | clone_output "$program $version\n" | |
10 | } | |
11 | ||
12 | # Cover function to target_compile. | |
13 | # Copied from gdb_compile. | |
14 | ||
15 | proc sim_compile { source dest type options } { | |
16 | set result [target_compile $source $dest $type $options] | |
17 | regsub "\[\r\n\]*$" "$result" "" result | |
18 | regsub "^\[\r\n\]*" "$result" "" result | |
19 | if { $result != "" } { | |
20 | clone_output "sim compile failed, $result" | |
21 | } | |
22 | return $result | |
23 | } | |
24 | ||
25 | # Run a program on the simulator. | |
26 | # Required by dejagnu (at least ${tool}_run used to be). | |
27 | # FIXME: What should we do with `redir'? | |
28 | # The result is a list of two elements. | |
29 | # The first is one of pass/fail/etc. | |
30 | # The second is the program's output. | |
31 | # | |
32 | # This is different than the sim_load routine provided by | |
33 | # dejagnu/config/sim.exp. It's not clear how to pass arguments to the | |
34 | # simulator (not the simulated program, the simulator) with sim_load. | |
35 | ||
36 | proc sim_run { prog sim_opts redir } { | |
37 | global SIMFLAGS | |
38 | ||
39 | # FIXME: The timeout value we actually want is a function of | |
40 | # host, target, and testcase. | |
41 | set testcase_timeout [board_info target sim_time_limit] | |
42 | if { "$testcase_timeout" == "" } { | |
43 | set testcase_timeout [board_info host testcase_timeout] | |
44 | } | |
45 | if { "$testcase_timeout" == "" } { | |
46 | set testcase_timeout 240 ;# 240 same as in dejagnu/config/sim.exp. | |
47 | } | |
48 | ||
49 | set sim [board_info target sim] | |
50 | ||
51 | remote_spawn host "$sim $SIMFLAGS $sim_opts $prog" | |
52 | set result [remote_wait host $testcase_timeout] | |
53 | ||
54 | set return_code [lindex $result 0] | |
55 | set output [lindex $result 1] | |
56 | # Remove the \r part of "\r\n" so we don't break all the patterns | |
57 | # we want to match. | |
58 | regsub -all -- "\r" $output "" output | |
59 | ||
60 | # ??? Not sure the test for pass/fail is right. | |
61 | # We just care that the simulator ran correctly, not whether the simulated | |
62 | # program return 0 or non-zero from `main'. | |
63 | set status fail | |
64 | if { $return_code == 0 } { | |
65 | set status pass | |
66 | } | |
67 | ||
68 | return [list $status $output] | |
69 | } | |
70 | ||
71 | # Initialize the testrun. | |
72 | # Required by dejagnu. | |
73 | ||
74 | proc sim_init { args } { | |
75 | # Need to return an empty string (copied from GAS). | |
76 | return "" | |
77 | } | |
78 | ||
79 | # Run testcase NAME. | |
80 | # NAME is either a fully specified file name, or just the file name in which | |
81 | # case $srcdir/$subdir will be prepended. | |
82 | # The file can contain options in the form "# option(mach list): value" | |
83 | # Possibilities: | |
84 | # mach(): machine names | |
85 | # as(mach): <assembler options> | |
86 | # ld(mach): <linker options> | |
87 | # sim(mach): <simulator options> | |
88 | # output(): program output pattern to match with string-match | |
89 | # If `output' is not specified, the program must output "pass". | |
90 | ||
91 | proc run_sim_test { name } { | |
92 | global subdir srcdir | |
93 | global AS ASFLAGS LD LDFLAGS SIMFLAGS | |
94 | global opts | |
95 | ||
96 | if [string match "*/*" $name] { | |
97 | set file $name | |
98 | set name [file tail $name] | |
99 | } else { | |
100 | set file "$srcdir/$subdir/$name" | |
101 | } | |
102 | ||
103 | set opt_array [slurp_options "${file}"] | |
104 | if { $opt_array == -1 } { | |
105 | unresolved $subdir/$name | |
106 | return | |
107 | } | |
108 | set opts(as) {} | |
109 | set opts(ld) {} | |
110 | set opts(sim) {} | |
111 | set opts(output) {} | |
112 | set opts(mach) {} | |
113 | ||
114 | foreach i $opt_array { | |
115 | set opt_name [lindex $i 0] | |
116 | set opt_machs [lindex $i 1] | |
117 | set opt_val [lindex $i 2] | |
118 | if ![info exists opts($opt_name)] { | |
119 | perror "unknown option $opt_name in file $file" | |
120 | unresolved $subdir/$name | |
121 | return | |
122 | } | |
123 | foreach m $opt_machs { | |
124 | set opts($opt_name,$m) $opt_val | |
125 | } | |
126 | if { "$opt_machs" == "" } { | |
127 | set opts($opt_name) $opt_val | |
128 | } | |
129 | } | |
130 | ||
131 | set testname $name | |
132 | set sourcefile $file | |
133 | if { $opts(output) == "" } { | |
134 | set opts(output) "pass\n" | |
135 | } | |
136 | ||
137 | foreach mach $opts(mach) { | |
138 | verbose "Testing $name on $mach." | |
139 | ||
140 | if ![info exists opts(as,$mach)] { | |
141 | set opts(as,$mach) $opts(as) | |
142 | } | |
143 | send_log "$AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile\n" | |
144 | catch "exec $AS $ASFLAGS $opts(as,$mach) -I$srcdir/$subdir -o ${name}.o $sourcefile" comp_output | |
145 | ||
146 | if ![string match "" $comp_output] { | |
147 | verbose -log "$comp_output" 3 | |
148 | fail "$mach $testname" | |
149 | continue | |
150 | } | |
151 | ||
152 | if ![info exists opts(ld,$mach)] { | |
153 | set opts(ld,$mach) $opts(ld) | |
154 | } | |
155 | send_log "$LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o\n" | |
156 | catch "exec $LD $LDFLAGS $opts(ld,$mach) -o ${name}.x ${name}.o" comp_output | |
157 | ||
158 | if ![string match "" $comp_output] { | |
159 | verbose -log "$comp_output" 3 | |
160 | fail "$mach $testname" | |
161 | continue | |
162 | } | |
163 | ||
164 | # If no machine specific options, default to the general version. | |
165 | if ![info exists opts(sim,$mach)] { | |
166 | set opts(sim,$mach) $opts(sim) | |
167 | } | |
168 | ||
169 | set result [sim_run ${name}.x "$opts(sim,$mach)" ""] | |
170 | set status [lindex $result 0] | |
171 | set output [lindex $result 1] | |
172 | ||
173 | if { "$status" == "pass" } { | |
174 | if ![string match $opts(output) $output] { | |
175 | verbose -log "output: $output" 3 | |
176 | verbose -log "pattern: $opts(output)" 3 | |
177 | } | |
178 | } | |
179 | ||
180 | $status "$mach $testname" | |
181 | } | |
182 | } | |
183 | ||
184 | # Subroutine of run_sim_test to process options in FILE. | |
185 | ||
186 | proc slurp_options { file } { | |
187 | if [catch { set f [open $file r] } x] { | |
188 | #perror "couldn't open `$file': $x" | |
189 | perror "$x" | |
190 | return -1 | |
191 | } | |
192 | set opt_array {} | |
193 | # whitespace expression | |
194 | set ws {[ ]*} | |
195 | set nws {[^ ]*} | |
196 | # whitespace is ignored anywhere except within the options list; | |
197 | # option names are alphabetic only | |
198 | set pat "^#${ws}(\[a-zA-Z\]*)\\((.*)\\)$ws:${ws}(.*)$ws\$" | |
199 | # Allow comment as first line of file. | |
200 | set firstline 1 | |
201 | while { [gets $f line] != -1 } { | |
202 | set line [string trim $line] | |
203 | # Whitespace here is space-tab. | |
204 | if [regexp $pat $line xxx opt_name opt_machs opt_val] { | |
205 | # match! | |
206 | lappend opt_array [list $opt_name $opt_machs $opt_val] | |
207 | } else { | |
208 | if { ! $firstline } { | |
209 | break | |
210 | } | |
211 | } | |
212 | set firstline 0 | |
213 | } | |
214 | close $f | |
215 | return $opt_array | |
216 | } |