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 -nottyinit $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.
189 proc run_dump_test { name } {
192 global OBJDUMPFLAGS NMFLAGS ASFLAGS
194 set file "$srcdir/$subdir/$name"
195 set opt_array [slurp_options "${file}.d"]
203 foreach i $opt_array {
204 set opt_name [lindex $i 0]
205 set opt_val [lindex $i 1]
206 if ![info exists opts($opt_name)] {
207 perror "unknown option $opt_name in file $file.d"
210 if [string length $opts($opt_name)] {
211 perror "option $opt_name multiply set in $file.d"
214 set opts($opt_name) $opt_val
217 if {$opts(PROG) != ""} {
218 switch -- $opts(PROG) {
220 { set program objdump }
224 { perror "unrecognized program option $opts(PROG) in $file.d"
227 } elseif {$opts(objdump) == "" && $opts(nm) != ""} {
229 } elseif {$opts(objdump) != "" && $opts(nm) == ""} {
232 perror "dump program unspecified in $file.d"
235 set progopts1 $opts($program)
236 eval set progopts \$[string toupper $program]FLAGS
237 eval set program \$[string toupper $program]
238 if { $opts(name) == "" } { set testname "$subdir/$name" } else { set testname $opts(name) }
240 if { $opts(source) == "" } {
241 set sourcefile ${file}.s
243 set sourcefile $srcdir/$subdir/$opts(source)
246 catch "exec $srcdir/lib/run $AS $ASFLAGS $opts(as) $sourcefile" comp_output
248 if ![string match "" $comp_output] then {
249 send_log "$comp_output\n"
250 verbose "$comp_output" 3
251 fail_phase $testname assembly "$ASFLAGS $opts(as)"
255 if { $progopts1 == "" } { set $progopts1 "-r" }
256 if [catch "exec $program $progopts $progopts1 > dump.out" comp_output] {
257 fail_phase $testname {running objdump} "$progopts $progopts1"
261 if { [regexp_diff "dump.out" "${file}.d"] } then {
262 fail_phase $testname {checking output} "$ASFLAGS $opts(as)"
269 proc slurp_options { file } {
270 if [catch { set f [open $file r] } x] {
271 perror "couldn't open `$file': $x"
274 # whitespace expression
277 # whitespace is ignored anywhere except within the options list;
278 # option names are alphabetic only
279 set pat "^#${ws}(\[a-zA-Z\]*)$ws:${ws}(.*)$ws\$"
280 while { [gets $f line] != -1 } {
281 set line [string trim $line]
282 # Whitespace here is space-tab.
283 if [regexp $pat $line xxx opt_name opt_val] {
285 lappend opt_array [list $opt_name $opt_val]
294 proc objdump { opts } {
298 catch "exec $OBJDUMP $opts" comp_output
299 verbose "objdump output=$comp_output\n" 3
302 proc objdump_start_no_subdir { prog opts } {
307 verbose "Starting $OBJDUMP $opts $prog" 2
309 spawn -noecho -nottyinit $srcdir/lib/run $OBJDUMP $opts $prog
311 if ![regexp {^[0-9]+} $foo] then {
312 perror "Can't run $prog: $foo"
316 proc objdump_finish { } {
323 # Default timeout is 10 seconds, loses on a slow machine. But some
324 # configurations of dejagnu may override it.
325 if {$timeout<120} then { set timeout 120 }
328 timeout { perror "timeout" }
329 "virtual memory exhausted" { perror "virtual memory exhausted" }
330 buffer_full { perror "buffer full" }
334 # regexp_diff, based on simple_diff taken from ld test suite
335 # compares two files line-by-line
336 # file1 contains strings, file2 contains regexps and #-comments
337 # blank lines are ignored in either file
338 # returns non-zero if differences exist
340 proc regexp_diff { file_1 file_2 } {
346 if [file exists $file_1] then {
347 set file_a [open $file_1 r]
349 warning "$file_1 doesn't exist"
353 if [file exists $file_2] then {
354 set file_b [open $file_2 r]
356 fail "$file_2 doesn't exist"
361 verbose " Regexp-diff'ing: $file_1 $file_2" 2
363 while { $differences == 0 && $end == 0 } {
366 while { [string length $line_a] == 0 } {
367 if { [gets $file_a line_a] == $eof } {
372 while { [string length $line_b] == 0 || [string match "#*" $line_b] } {
373 if { [gets $file_b line_b] == $eof } {
378 if { $end } { break }
379 verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3
380 if ![regexp "^$line_b$" "$line_a"] {
381 send_log "regexp_diff match failure\n"
382 send_log "regexp \"^$line_b$\"\nline \"$line_a\"\n"
387 if { $differences == 0 && [eof $file_a] != [eof $file_b] } {
388 send_log "different lengths\n"
389 verbose "different lengths" 3