* lib/gas-defs.exp (run_dump_test): New routine for running the

assembler, running objdump or nm (not fully supported) on the
	resulting object file, and comparing the results against a file of
	regular expressions in the test suite, all in one command.
	(fail_phase, slurp_options): New auxiliary routines.
	(regexp_diff): Always return a value.  Fix bugs in actually doing
	the regexp test.

Should make it even easier to write gas test cases, giving Ian even less
excuse for not doing so. :-)
This commit is contained in:
Ken Raeburn 1994-07-15 23:13:10 +00:00
parent 9ca16e0e33
commit 8cbd903e9c
2 changed files with 143 additions and 11 deletions

View File

@ -1,3 +1,24 @@
Fri Jul 15 19:09:25 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
* lib/gas-defs.exp (run_dump_test): New routine for running the
assembler, running objdump or nm (not fully supported) on the
resulting object file, and comparing the results against a file of
regular expressions in the test suite, all in one command.
(fail_phase, slurp_options): New auxiliary routines.
(regexp_diff): Always return a value. Fix bugs in actually doing
the regexp test.
Thu Jul 7 11:55:33 1994 Jeff Law (law@snake.cs.utah.edu)
* gas/hppa/reloc/relocreduce2.s: More relocation reduction tests.
* gas/hppa/reloc/reloc.exp: Run them.
Thu Jun 30 18:49:25 1994 Ken Raeburn (raeburn@cujo.cygnus.com)
* config/default.exp: Look for "as.new" in "$base_dir/..", where
it got compiled, not in "$base_dir".
* config/unknown.exp: Deleted.
Sun Jun 26 13:23:54 1994 Jeff Law (law@snake.cs.utah.edu) Sun Jun 26 13:23:54 1994 Jeff Law (law@snake.cs.utah.edu)
* gas/lib/gas-defs.exp (gas_finish): Call "close" and "wait" * gas/lib/gas-defs.exp (gas_finish): Call "close" and "wait"

View File

@ -66,8 +66,8 @@ proc gas_start { prog as_opts } {
proc gas_finish { } { proc gas_finish { } {
global spawn_id global spawn_id
close catch "close"
# Might also need a wait here one day. catch "wait"
} }
proc want_no_output { testname } { proc want_no_output { testname } {
@ -172,6 +172,117 @@ proc gas_init {} {
return return
} }
# For easier reading.
proc fail_phase { name phase opts } {
set opts [string trim $opts]
if { $opts == "" } {
fail "$name ($phase)"
} else {
fail "$name ($phase: $opts)"
}
}
# This proc requires two input files -- the .s file containing the
# assembly source, and a .d file containing the expected output from
# objdump or nm or whatever, and leading comments indicating any options
# to be passed to the assembler or dump program.
proc run_dump_test { name } {
global subdir srcdir
global OBJDUMP NM AS
global OBJDUMPFLAGS NMFLAGS ASFLAGS
set file "$srcdir/$subdir/$name"
set opt_array [slurp_options "${file}.d"]
set opts(as) {}
set opts(objdump) {}
set opts(nm) {}
set opts(name) {}
set opts(PROG) {}
foreach i $opt_array {
set opt_name [lindex $i 0]
set opt_val [lindex $i 1]
if ![info exists opts($opt_name)] {
perror "unknown option $opt_name in file $file.d"
return
}
if [string length $opts($opt_name)] {
perror "option $opt_name multiply set in $file.d"
return
}
set opts($opt_name) $opt_val
}
if {$opts(PROG) != ""} {
switch -- $opts(PROG) {
objdump
{ set program objdump }
nm
{ set program nm }
default
{ perror "unrecognized program option $opts(PROG) in $file.d"
return }
}
} elseif {$opts(objdump) == "" && $opts(nm) != ""} {
set program nm
} elseif {$opts(objdump) != "" && $opts(nm) == ""} {
set program objdump
} else {
perror "dump program unspecified in $file.d"
return
}
set progopts1 $opts($program)
eval set progopts \$[string toupper $program]FLAGS
eval set program \$[string toupper $program]
if { $opts(name) == "" } { set testname "$subdir/$name" } else { set testname $opts(name) }
catch "exec $srcdir/lib/run $AS $ASFLAGS $opts(as) ${file}.s" comp_output
if ![string match "" $comp_output] then {
send_log "$comp_output\n"
verbose "$comp_output" 3
fail_phase $testname assembly "$ASFLAGS $opts(as)"
return
}
if [catch "exec $program -r > dump.out" comp_output] {
fail_phase $testname {running objdump} {-r}
return
}
if { [regexp_diff "dump.out" "${file}.d"] } then {
fail_phase $testname {checking output} "$ASFLAGS $opts(as)"
return
}
pass $testname
}
proc slurp_options { file } {
if [catch { set f [open $file r] } x] {
perror "couldn't open `$file': $x"
}
set opt_array {}
# whitespace expression
set ws {[ ]*}
set nws {[^ ]*}
# whitespace is ignored anywhere except within the options list;
# option names are alphabetic only
set pat "^#${ws}(\[a-zA-Z\]*)$ws:${ws}($nws)$ws\$"
while { [gets $f line] != -1 } {
set line [string trim $line]
# Whitespace here is space-tab.
if [regexp $pat $line xxx opt_name opt_val] {
# match!
lappend opt_array [list $opt_name $opt_val]
} else {
break
}
}
close $f
return $opt_array
}
proc objdump { opts } { proc objdump { opts } {
global OBJDUMP global OBJDUMP
global comp_output global comp_output
@ -197,8 +308,8 @@ proc objdump_start_no_subdir { prog opts } {
proc objdump_finish { } { proc objdump_finish { } {
global spawn_id global spawn_id
close catch "close"
# Might also need a wait here one day. catch "wait"
} }
expect_after { expect_after {
@ -224,7 +335,7 @@ proc regexp_diff { file_1 file_2 } {
set file_a [open $file_1 r] set file_a [open $file_1 r]
} else { } else {
warning "$file_1 doesn't exist" warning "$file_1 doesn't exist"
return return 1
} }
if [file exists $file_2] then { if [file exists $file_2] then {
@ -232,7 +343,7 @@ proc regexp_diff { file_1 file_2 } {
} else { } else {
fail "$file_2 doesn't exist" fail "$file_2 doesn't exist"
close $file_a close $file_a
return return 1
} }
verbose " Regexp-diff'ing: $file_1 $file_2" 2 verbose " Regexp-diff'ing: $file_1 $file_2" 2
@ -254,7 +365,7 @@ proc regexp_diff { file_1 file_2 } {
} }
if { $end } { break } if { $end } { break }
verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3 verbose "regexp \"^$line_b$\"\nline \"$line_a\"" 3
if [regexp "^$line_b$" "$line_a\n"] { if ![regexp "^$line_b$" "$line_a"] {
verbose "no match" 3 verbose "no match" 3
set differences 1 set differences 1
} }