*** empty log message ***

This commit is contained in:
David Edelsohn
1995-04-08 19:50:44 +00:00
parent 6b61e21dbb
commit 91e3b58270

View File

@ -186,13 +186,23 @@ proc fail_phase { name phase opts } {
# assembly source, and a .d file containing the expected output from # assembly source, and a .d file containing the expected output from
# objdump or nm or whatever, and leading comments indicating any options # objdump or nm or whatever, and leading comments indicating any options
# to be passed to the assembler or dump program. # to be passed to the assembler or dump program.
proc run_dump_test { name } { proc run_dump_test { name } {
global subdir srcdir global subdir srcdir
global OBJDUMP NM AS global OBJDUMP NM AS
global OBJDUMPFLAGS NMFLAGS ASFLAGS global OBJDUMPFLAGS NMFLAGS ASFLAGS
set file "$srcdir/$subdir/$name" if [string match "*/*" $name] {
set file $name
set name [file tail $name]
} else {
set file "$srcdir/$subdir/$name"
}
set opt_array [slurp_options "${file}.d"] set opt_array [slurp_options "${file}.d"]
if { $opt_array == -1 } {
unresolved $subdir/$name
return
}
set opts(as) {} set opts(as) {}
set opts(objdump) {} set opts(objdump) {}
set opts(nm) {} set opts(nm) {}
@ -205,10 +215,12 @@ proc run_dump_test { name } {
set opt_val [lindex $i 1] set opt_val [lindex $i 1]
if ![info exists opts($opt_name)] { if ![info exists opts($opt_name)] {
perror "unknown option $opt_name in file $file.d" perror "unknown option $opt_name in file $file.d"
unresolved $subdir/$name
return return
} }
if [string length $opts($opt_name)] { if [string length $opts($opt_name)] {
perror "option $opt_name multiply set in $file.d" perror "option $opt_name multiply set in $file.d"
unresolved $subdir/$name
return return
} }
set opts($opt_name) $opt_val set opts($opt_name) $opt_val
@ -222,6 +234,7 @@ proc run_dump_test { name } {
{ set program nm } { set program nm }
default default
{ perror "unrecognized program option $opts(PROG) in $file.d" { perror "unrecognized program option $opts(PROG) in $file.d"
unresolved $subdir/$name
return } return }
} }
} elseif {$opts(objdump) == "" && $opts(nm) != ""} { } elseif {$opts(objdump) == "" && $opts(nm) != ""} {
@ -230,12 +243,17 @@ proc run_dump_test { name } {
set program objdump set program objdump
} else { } else {
perror "dump program unspecified in $file.d" perror "dump program unspecified in $file.d"
unresolved $subdir/$name
return return
} }
set progopts1 $opts($program) set progopts1 $opts($program)
eval set progopts \$[string toupper $program]FLAGS eval set progopts \$[string toupper $program]FLAGS
eval set program \$[string toupper $program] eval set program \$[string toupper $program]
if { $opts(name) == "" } { set testname "$subdir/$name" } else { set testname $opts(name) } if { $opts(name) == "" } {
set testname "$subdir/$name"
} else {
set testname $opts(name)
}
if { $opts(source) == "" } { if { $opts(source) == "" } {
set sourcefile ${file}.s set sourcefile ${file}.s
@ -253,11 +271,13 @@ proc run_dump_test { name } {
} }
if { $progopts1 == "" } { set $progopts1 "-r" } if { $progopts1 == "" } { set $progopts1 "-r" }
verbose "running $program $progopts $progopts1" 3
if [catch "exec $program $progopts $progopts1 > dump.out" comp_output] { if [catch "exec $program $progopts $progopts1 > dump.out" comp_output] {
fail_phase $testname {running objdump} "$progopts $progopts1" fail_phase $testname {running objdump} "$progopts $progopts1"
return return
} }
verbose_eval {[file_contents "dump.out"]} 3
if { [regexp_diff "dump.out" "${file}.d"] } then { if { [regexp_diff "dump.out" "${file}.d"] } then {
fail_phase $testname {checking output} "$ASFLAGS $opts(as)" fail_phase $testname {checking output} "$ASFLAGS $opts(as)"
return return
@ -268,7 +288,9 @@ proc run_dump_test { name } {
proc slurp_options { file } { proc slurp_options { file } {
if [catch { set f [open $file r] } x] { if [catch { set f [open $file r] } x] {
perror "couldn't open `$file': $x" #perror "couldn't open `$file': $x"
perror "$x"
return -1
} }
set opt_array {} set opt_array {}
# whitespace expression # whitespace expression
@ -395,3 +417,15 @@ proc regexp_diff { file_1 file_2 } {
return $differences return $differences
} }
proc file_contents { filename } {
set file [open $filename r]
set contents [read $file]
close $file
return $contents
}
proc verbose_eval { expr { level 1 } } {
global verbose
if $verbose>$level then { eval verbose "$expr" $level }
}