mirror of
git://gcc.gnu.org/git/gcc.git
synced 2024-12-22 13:09:50 +08:00
9cb0bef59f
* libjava.mauve/mauve.exp (test_mauve): Call `prune_warnings'. (test_mauve_sim): Likewise. (test_mauve): Redirect stderr in system call. (test_mauve_sim): Likewise. * lib/libjava.exp (test_libjava_from_source): Call `prune_warnings'. (test_libjava_from_javac): Likewise. (bytecompile_file): Redirect stderr in system call. * lib/libjava.exp (libjava_find_program): New proc. (find_jvscan): Use it. (find_gcjh): New proc. * libjava.compile/compile.exp: Use "", not $options. From-SVN: r33959
390 lines
9.8 KiB
Plaintext
390 lines
9.8 KiB
Plaintext
# Copyright (C) 1998, 1999, 2000 Free Software Foundation.
|
|
# Written by Tom Tromey <tromey@cygnus.com>.
|
|
# Incorporate Mauve into libjava's DejaGNU test suite framework.
|
|
|
|
# FIXME: should be able to compile from source as well as from .class.
|
|
|
|
|
|
# Compute list of files to compile. Returns list of all files
|
|
# representing classes that must be tested. Result parameter `uses'
|
|
# maps source file names onto list of objects required for link.
|
|
proc mauve_compute_uses {aName} {
|
|
upvar $aName uses
|
|
global env runtests
|
|
|
|
set fd [open classes r]
|
|
set line [read $fd]
|
|
close $fd
|
|
|
|
foreach item [split $line] {
|
|
if {$item == ""} then {
|
|
continue
|
|
}
|
|
set item [join [split $item .] /].java
|
|
|
|
# User might have specified "mauve.exp=something.java".
|
|
if {! [runtest_file_p $runtests $item]} {
|
|
continue
|
|
}
|
|
|
|
# Look for Uses line in source file.
|
|
set fd [open $env(MAUVEDIR)/$item r]
|
|
set ufiles [list $item]
|
|
set dir [file dirname $item]
|
|
while {[gets $fd sline] != -1} {
|
|
if {[regsub -- {^// Uses:} $sline {} sline]} then {
|
|
foreach uf [split $sline] {
|
|
if {$uf != ""} then {
|
|
lappend ufiles $dir/$uf
|
|
}
|
|
}
|
|
}
|
|
}
|
|
close $fd
|
|
|
|
set uses($item) {}
|
|
foreach file $ufiles {
|
|
set file [file rootname $file].o
|
|
lappend uses($item) $file
|
|
}
|
|
}
|
|
|
|
return [lsort [array names uses]]
|
|
}
|
|
|
|
# Run all the Mauve tests.
|
|
proc test_mauve {} {
|
|
global srcdir objdir subdir env
|
|
|
|
if {! [info exists env(MAUVEDIR)]} then {
|
|
verbose "MAUVEDIR not set; not running Mauve tests"
|
|
return
|
|
}
|
|
|
|
# Run in subdir so we don't overwrite our own Makefile.
|
|
catch {system "rm -rf mauve-build"}
|
|
file mkdir mauve-build
|
|
# Some weirdness to set srcdir correctly.
|
|
set here [pwd]
|
|
cd $srcdir
|
|
set full_srcdir [pwd]
|
|
cd $here/mauve-build
|
|
|
|
global env
|
|
global GCJ_UNDER_TEST
|
|
global TOOL_EXECUTABLE
|
|
|
|
if ![info exists GCJ_UNDER_TEST] {
|
|
if [info exists TOOL_EXECUTABLE] {
|
|
set GCJ_UNDER_TEST $TOOL_EXECUTABLE;
|
|
} else {
|
|
if [info exists env(GCJ)] {
|
|
set GCJ_UNDER_TEST env(GCJ)
|
|
} else {
|
|
set GCJ_UNDER_TEST "[find_gcj]"
|
|
}
|
|
}
|
|
}
|
|
|
|
# Append -B and -I so that libgcj.spec and libgcj.zip are found
|
|
# before they're installed.
|
|
set env(GCJ) "$GCJ_UNDER_TEST -B$objdir/../ -I$objdir/../libgcj.zip"
|
|
|
|
if {[catch {
|
|
system "$env(MAUVEDIR)/configure --with-gcj 2>@ stdout"
|
|
} msg]} then {
|
|
fail "Mauve configure"
|
|
verbose "configure failed with $msg"
|
|
return
|
|
}
|
|
pass "Mauve configure"
|
|
|
|
# Copy appropriate tags file locally.
|
|
set fd [open $full_srcdir/../mauve-libgcj r]
|
|
set c [read $fd]
|
|
close $fd
|
|
set fd [open mauve-libgcj w]
|
|
puts -nonewline $fd $c
|
|
close $fd
|
|
|
|
if {[catch {
|
|
system "make KEYS=libgcj classes.stamp 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve build"
|
|
verbose "build failed with $msg"
|
|
return
|
|
}
|
|
pass "Mauve build"
|
|
|
|
set srcfile $full_srcdir/$subdir/DejaGNUTestHarness.java
|
|
if {! [bytecompile_file $srcfile [pwd] $env(MAUVEDIR):[pwd]]} then {
|
|
fail "Compile DejaGNUTestHarness.java"
|
|
return
|
|
}
|
|
pass "Compile DejaGNUTestHarness.java"
|
|
|
|
# Compute list of files to test, and also all files to build.
|
|
set choices [mauve_compute_uses uses]
|
|
|
|
# Compute flags to use to do the build.
|
|
set compile_args [libjava_arguments]
|
|
set link_args [concat [libjava_arguments link] \
|
|
[list "additional_flags=--main=DejaGNUTestHarness"]]
|
|
|
|
set ok 1
|
|
set objlist {}
|
|
foreach base {DejaGNUTestHarness gnu/testlet/SimpleTestHarness gnu/testlet/TestHarness gnu/testlet/Testlet gnu/testlet/ResourceNotFoundException gnu/testlet/config} {
|
|
set file $base.class
|
|
set obj $base.o
|
|
set x [prune_warnings \
|
|
[target_compile [pwd]/$file $obj object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile $obj"
|
|
set ok 0
|
|
} else {
|
|
pass "Compile $obj"
|
|
}
|
|
lappend objlist $obj
|
|
}
|
|
if {! $ok} then {
|
|
return
|
|
}
|
|
|
|
set Executable DejaGNUTestHarness
|
|
foreach file $choices {
|
|
# Turn `java/lang/Foo.java' into `java.lang.Foo'.
|
|
set class [file rootname $file]
|
|
regsub -all -- / $class . class
|
|
|
|
set ok 1
|
|
foreach obj $uses($file) {
|
|
if {! [file exists $obj]} then {
|
|
verbose "compiling $obj for test of $class"
|
|
set srcfile [file rootname $obj].class
|
|
set x [prune_warnings \
|
|
[target_compile [pwd]/$srcfile $obj object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile $obj for $class"
|
|
set ok 0
|
|
break
|
|
}
|
|
pass "Compile $obj for $class"
|
|
}
|
|
}
|
|
if {! $ok} then {
|
|
continue
|
|
}
|
|
|
|
set x [prune_warnings [target_compile [concat $uses($file) $objlist] \
|
|
$Executable executable $link_args]]
|
|
if {$x != ""} then {
|
|
fail "Link for $class"
|
|
continue
|
|
}
|
|
pass "Link for $class"
|
|
|
|
set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|
"$env(MAUVEDIR) $class" ""]
|
|
|
|
# Test for an exception thrown in the test harness itself. This
|
|
# isn't enough to test for all faults in the test harness, but
|
|
# it's better than nothing.
|
|
set output [lindex $result 1];
|
|
if [regexp "Exception: " $output] then {
|
|
fail $output
|
|
continue
|
|
}
|
|
|
|
pass "Execute for $class"
|
|
|
|
# Extract pass/failure info from output.
|
|
foreach line [split [lindex $result 1] \n] {
|
|
if {[regexp -- {^(PASS|FAIL): (.*)$} $line ignore what msg]} then {
|
|
if {$what == "PASS"} then {
|
|
pass $msg
|
|
} else {
|
|
fail $msg
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# Run all the Mauve tests in a sim environment. In this case, the
|
|
# program cannot use argv[] because there's no way to pass in the
|
|
# command line, so tha name of the class to test is substituted by
|
|
# patching the source of the DejaGNUTestHarness.
|
|
proc test_mauve_sim {} {
|
|
global srcdir subdir env
|
|
|
|
if {! [info exists env(MAUVEDIR)]} then {
|
|
verbose "MAUVEDIR not set; not running Mauve tests"
|
|
return
|
|
}
|
|
|
|
# Run in subdir so we don't overwrite our own Makefile.
|
|
catch {system "rm -rf mauve-build"}
|
|
file mkdir mauve-build
|
|
# Some weirdness to set srcdir correctly.
|
|
set here [pwd]
|
|
cd $srcdir
|
|
set full_srcdir [pwd]
|
|
cd $here/mauve-build
|
|
|
|
if {[catch {
|
|
system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve configure"
|
|
verbose "configure failed with $msg"
|
|
return
|
|
}
|
|
pass "Mauve configure"
|
|
|
|
# Copy appropriate tags file locally.
|
|
set fd [open $full_srcdir/../mauve-libgcj r]
|
|
set c [read $fd]
|
|
close $fd
|
|
set fd [open mauve-libgcj w]
|
|
puts -nonewline $fd $c
|
|
close $fd
|
|
|
|
if {[catch {
|
|
system "make KEYS=libgcj classes.stamp 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve build"
|
|
verbose "build failed with $msg"
|
|
return
|
|
}
|
|
pass "Mauve build"
|
|
|
|
# Compute list of files to test, and also all files to build.
|
|
set choices [mauve_compute_uses uses]
|
|
|
|
# Compute flags to use to do the build.
|
|
set compile_args [libjava_arguments]
|
|
set link_args [concat [libjava_arguments link] \
|
|
[list "additional_flags=--main=DejaGNUTestHarness"]]
|
|
|
|
set ok 1
|
|
set objlist {}
|
|
foreach base {gnu/testlet/SimpleTestHarness gnu/testlet/TestHarness \
|
|
gnu/testlet/Testlet gnu/testlet/ResourceNotFoundException \
|
|
gnu/testlet/config} {
|
|
set file $base.class
|
|
set obj $base.o
|
|
set x [prune_warnings \
|
|
[target_compile [pwd]/$file $obj object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile $obj"
|
|
set ok 0
|
|
} else {
|
|
pass "Compile $obj"
|
|
}
|
|
lappend objlist $obj
|
|
}
|
|
if {! $ok} then {
|
|
return
|
|
}
|
|
|
|
lappend objlist gnu/testlet/DejaGNUTestHarness.o
|
|
|
|
set Executable DejaGNUTestHarness
|
|
foreach file $choices {
|
|
# Turn `java/lang/Foo.java' into `java.lang.Foo'.
|
|
|
|
set class [file rootname $file]
|
|
regsub -all -- / $class . class
|
|
|
|
set ok 1
|
|
foreach obj $uses($file) {
|
|
if {! [file exists $obj]} then {
|
|
verbose "compiling $obj for test of $class"
|
|
set srcfile [file rootname $obj].class
|
|
set x [prune_warnings \
|
|
[target_compile [pwd]/$srcfile $obj object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile $obj for $class"
|
|
set ok 0
|
|
break
|
|
}
|
|
pass "Compile $obj for $class"
|
|
}
|
|
}
|
|
if {! $ok} then {
|
|
continue
|
|
}
|
|
|
|
set infile $full_srcdir/$subdir/DejaGNUTestHarness.java
|
|
set srcfile DejaGNUTestHarness.java
|
|
set f [open $infile r]
|
|
set d [open gnu/testlet/$srcfile w]
|
|
while {[gets $f line] >= 0} {
|
|
if [regexp {harness\.runtest \(args\[1\]\)} $line] then {
|
|
regsub {args\[1\]} $line "\"$class\"" out
|
|
} else {
|
|
set out $line
|
|
}
|
|
puts $d $out
|
|
}
|
|
close $f
|
|
close $d
|
|
|
|
if {! [bytecompile_file [pwd]/gnu/testlet/$srcfile [pwd]/gnu/testlet \
|
|
$env(MAUVEDIR):[pwd]]} then {
|
|
fail "Compile DejaGNUTestHarness.java"
|
|
return
|
|
}
|
|
|
|
set x [prune_warnings \
|
|
[target_compile gnu/testlet/DejaGNUTestHarness.class \
|
|
gnu/testlet/DejaGNUTestHarness.o object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile DejaGNUTestHarness.java"
|
|
continue
|
|
}
|
|
|
|
set x [prune_warnings [target_compile [concat $uses($file) $objlist] \
|
|
$Executable executable $link_args]]
|
|
if {$x != ""} then {
|
|
fail "Link for $class"
|
|
continue
|
|
}
|
|
pass "Link for $class"
|
|
|
|
set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|
"$env(MAUVEDIR) $class" ""]
|
|
|
|
# Test for an exception thrown in the test harness itself. This
|
|
# isn't enough to test for all faults in the test harness, but
|
|
# it's better than nothing.
|
|
set output [lindex $result 1];
|
|
if [regexp "Exception: " $output] then {
|
|
fail $output
|
|
continue
|
|
}
|
|
|
|
pass "Execute for $class"
|
|
|
|
# Extract pass/failure info from output.
|
|
foreach line [split [lindex $result 1] \n] {
|
|
if {[regexp -- {^(PASS|FAIL): (.*)$} $line ignore what msg]} then {
|
|
if {$what == "PASS"} then {
|
|
pass $msg
|
|
} else {
|
|
fail $msg
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
# The test_mauve* procs will change the current directory. It's
|
|
# simpler to fix this up here than to keep track of this in the procs.
|
|
set here [pwd]
|
|
if { [board_info target exists is_simulator] } {
|
|
test_mauve_sim
|
|
} else {
|
|
test_mauve
|
|
}
|
|
cd $here
|