1 # Copyright (C) 1993, 1994 Free Software Foundation, Inc.
3 # This program is free software; you can redistribute it and/or modify
4 # it under the terms of the GNU General Public License as published by
5 # the Free Software Foundation; either version 2 of the License, or
6 # (at your option) any later version.
8 # This program is distributed in the hope that it will be useful,
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 # GNU General Public License for more details.
13 # You should have received a copy of the GNU General Public License
14 # along with this program; if not, write to the Free Software
15 # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. */
17 # Please email any bugs, comments, and/or additions to this file to:
20 # This file was written by Ken Raeburn (raeburn@cygnus.com).
24 catch "exec $AS -version < /dev/null" tmp
25 # Should find a way to discard constant parts, keep whatever's
26 # left, so the version string could be almost anything at all...
27 regexp "version (cygnus-|)\[-0-9.a-zA-Z-\]+" $tmp version
29 clone_output "[which $AS] $version\n"
34 proc gas_run { prog as_opts redir } {
41 verbose "Executing $AS $ASFLAGS $as_opts $prog $redir"
42 catch "exec $srcdir/lib/run $AS $ASFLAGS $as_opts $srcdir/$subdir/$prog $redir" comp_output
45 proc all_ones { args } {
46 foreach x $args { if [expr $x!=1] { return 0 } }
50 proc gas_start { prog as_opts } {
57 verbose "Starting $AS $ASFLAGS $as_opts $prog" 2
59 spawn -noecho -nottycopy $srcdir/lib/run $AS $ASFLAGS $as_opts $srcdir/$subdir/$prog
61 if ![regexp {^[0-9]+} $foo] then {
62 perror "Can't run $subdir/$prog: $foo"
73 proc want_no_output { testname } {
76 if ![string match "" $comp_output] then {
77 send_log "$comp_output\n"
78 verbose "$comp_output" 3
80 if [string match "" $comp_output] then {
89 proc gas_test_old { file as_opts testname } {
90 gas_run $file $as_opts ""
91 return [want_no_output $testname]
94 proc gas_test { file as_opts var_opts testname } {
98 foreach word $var_opts {
99 set ignore_stdout($i) [string match "*>" $word]
100 set opt($i) [string trim $word {>}]
104 for {set i 0} {[expr $i<$max]} {incr i} {
105 set maybe_ignore_stdout ""
107 for {set bit 0} {(1<<$bit)<$max} {incr bit} {
108 set num [expr 1<<$bit]
109 if [expr $i&$num] then {
110 set extra_opts "$extra_opts $opt($bit)"
111 if $ignore_stdout($bit) then {
112 set maybe_ignore_stdout ">/dev/null"
116 set extra_opts [string trim $extra_opts]
117 gas_run $file "$as_opts $extra_opts" $maybe_ignore_stdout
119 # Should I be able to use a conditional expression here?
120 if [string match "" $extra_opts] then {
121 want_no_output $testname
123 want_no_output "$testname ($extra_opts)"
126 if [info exists errorInfo] then {
131 proc gas_test_ignore_stdout { file as_opts testname } {
134 gas_run $file $as_opts ">/dev/null"
135 want_no_output $testname
138 proc gas_test_error { file as_opts testname } {
141 gas_run $file $as_opts ">/dev/null"
142 if ![string match "" $comp_output] then {
143 send_log "$comp_output\n"
144 verbose "$comp_output" 3
146 if [string match "" $comp_output] then {
157 global target_cpu_family
163 case "$target_cpu" in {
164 "m68???" { set target_cpu_family m68k }
165 "i[34]86" { set target_cpu_family i386 }
166 default { set target_cpu_family $target_cpu }
169 set target_family "$target_cpu_family-$target_vendor-$target_os"
171 # Need to return an empty string.
175 # For easier reading.
176 proc fail_phase { name phase opts } {
177 set opts [string trim $opts]
179 fail "$name ($phase)"
181 fail "$name ($phase: $opts)"
185 # This proc requires two input files -- the .s file containing the
186 # assembly source, and a .d file containing the expected output from
187 # objdump or nm or whatever, and leading comments indicating any options
188 # to be passed to the assembler or dump program.
190 proc run_dump_test { name } {
193 global OBJDUMPFLAGS NMFLAGS ASFLAGS
195 if [string match "*/*" $name] {
197 set name [file tail $name]
199 set file "$srcdir/$subdir/$name"
201 set opt_array [slurp_options "${file}.d"]
202 if { $opt_array == -1 } {
203 unresolved $subdir/$name
213 foreach i $opt_array {
214 set opt_name [lindex $i 0]
215 set opt_val [lindex $i 1]
216 if ![info exists opts($opt_name)] {
217 perror "unknown option $opt_name in file $file.d"
218 unresolved $subdir/$name
221 if [string length $opts($opt_name)] {
222 perror "option $opt_name multiply set in $file.d"
223 unresolved $subdir/$name
226 set opts($opt_name) $opt_val
229 if {$opts(PROG) != ""} {
230 switch -- $opts(PROG) {
232 { set program objdump }
236 { perror "unrecognized program option $opts(PROG) in $file.d"
237 unresolved $subdir/$name
240 } elseif {$opts(objdump) == "" && $opts(nm) != ""} {
242 } elseif {$opts(objdump) != "" && $opts(nm) == ""} {
245 perror "dump program unspecified in $file.d"
246 unresolved $subdir/$name
249 set progopts1 $opts($program)
250 eval set progopts \$[string toupper $program]FLAGS
251 eval set program \$[string toupper $program]
252 if { $opts(name) == "" } {
253 set testname "$subdir/$name"
255 set testname $opts(name)
258 if { $opts(source) == "" } {
259 set sourcefile ${file}.s
261 set sourcefile $srcdir/$subdir/$opts(source)
264 catch "exec $srcdir/lib/run $AS $ASFLAGS $opts(as) $sourcefile" comp_output
266 if ![string match "" $comp_output] then {
267 send_log "$comp_output\n"
268 verbose "$comp_output" 3
269 fail_phase $testname assembly "$ASFLAGS $opts(as)"
273 if { $progopts1 == "" } { set $progopts1 "-r" }
274 verbose "running $program $progopts $progopts1" 3
275 if [catch "exec $program $progopts $progopts1 > dump.out" comp_output] {
276 fail_phase $testname {running objdump} "$progopts $progopts1"
280 verbose_eval {[file_contents "dump.out"]} 3
281 if { [regexp_diff "dump.out" "${file}.d"] } then {
282 fail_phase $testname {checking output} "$ASFLAGS $opts(as)"
289 proc slurp_options { file } {
290 if [catch { set f [open $file r] } x] {
291 #perror "couldn't open `$file': $x"
296 # whitespace expression
299 # whitespace is ignored anywhere except within the options list;
300 # option names are alphabetic only
301 set pat "^#${ws}(\[a-zA-Z\]*)$ws:${ws}(.*)$ws\$"
302 while { [gets $f line] != -1 } {
303 set line [string trim $line]
304 # Whitespace here is space-tab.
305 if [regexp $pat $line xxx opt_name opt_val] {
307 lappend opt_array [list $opt_name $opt_val]
316 proc objdump { opts } {
320 catch "exec $OBJDUMP $opts" comp_output
321 verbose "objdump output=$comp_output\n" 3
324 proc objdump_start_no_subdir { prog opts } {
329 verbose "Starting $OBJDUMP $opts $prog" 2
331 spawn -noecho -nottyinit $srcdir/lib/run $OBJDUMP $opts $prog
333 if ![regexp {^[0-9]+} $foo] then {
334 perror "Can't run $prog: $foo"
338 proc objdump_finish { } {
345 # Default timeout is 10 seconds, loses on a slow machine. But some
346 # configurations of dejagnu may override it.
347 if {$timeout<120} then { set timeout 120 }
350 timeout { perror "timeout" }
351 "virtual memory exhausted" { perror "virtual memory exhausted" }
352 buffer_full { perror "buffer full" }
356 # regexp_diff, based on simple_diff taken from ld test suite
357 # compares two files line-by-line
358 # file1 contains strings, file2 contains regexps and #-comments
359 # blank lines are ignored in either file
360 # returns non-zero if differences exist
362 proc regexp_diff { file_1 file_2 } {
368 if [file exists $file_1] then {
369 set file_a [open $file_1 r]
371 warning "$file_1 doesn't exist"
375 if [file exists $file_2] then {
376 set file_b [open $file_2 r]
378 fail "$file_2 doesn't exist"
383 verbose " Regexp-diff'ing: $file_1 $file_2" 2
385 while { $differences == 0 && $end == 0 } {
388 while { [string length $line_a] == 0 } {
389 if { [gets $file_a line_a] == $eof } {
394 while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
395 if { [gets $file_b line_b] == $eof } {
400 if { $end } { break }
401 verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3
402 if ![regexp "^$line_b$" "$line_a"] {
403 send_log "regexp_diff match failure\n"
404 send_log "regexp \"^$line_b$\"\nline \"$line_a\"\n"
409 if { $differences == 0 && [eof $file_a] != [eof $file_b] } {
410 send_log "different lengths\n"
411 verbose "different lengths" 3
421 proc file_contents { filename } {
422 set file [open $filename r]
423 set contents [read $file]
428 proc verbose_eval { expr { level 1 } } {
430 if $verbose>$level then { eval verbose "$expr" $level }