mirror of git://gcc.gnu.org/git/gcc.git
447 lines
11 KiB
Plaintext
447 lines
11 KiB
Plaintext
# Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 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
|
|
# Now add all inner classes
|
|
foreach inner [glob -nocomplain [file rootname $file]$*.class] {
|
|
# Prevent excessive escaping by replacing $ with a ^ in the .o name
|
|
set inner [file rootname $inner].o
|
|
regsub -all "\\$" $inner "\^" inner
|
|
lappend uses($item) $inner
|
|
}
|
|
}
|
|
}
|
|
|
|
return [lsort [array names uses]]
|
|
}
|
|
|
|
# Find Mauve sources. At end, env(MAUVEDIR) points to sources.
|
|
# Returns 0 if sources not found, 1 otherwise.
|
|
proc find_mauve_sources {} {
|
|
global env srcdir
|
|
|
|
if {[info exists env(MAUVEDIR)]} {
|
|
return 1
|
|
} elseif {[file isdirectory $srcdir/libjava.mauve/mauve]} {
|
|
set env(MAUVEDIR) $srcdir/libjava.mauve/mauve
|
|
return 1
|
|
}
|
|
|
|
return 0
|
|
}
|
|
|
|
# Find all the harness files and return a list of them, with no
|
|
# suffix.
|
|
proc mauve_find_harness_files {} {
|
|
set result {}
|
|
foreach file [glob -nocomplain -- *.class gnu/testlet/*.class] {
|
|
lappend result [file root $file]
|
|
}
|
|
return $result
|
|
}
|
|
|
|
# Run all the Mauve tests. Return 1 on success, 0 on any failure. If
|
|
# the tests are skipped, that is treated like success.
|
|
proc test_mauve {} {
|
|
global srcdir objdir subdir env
|
|
|
|
if {! [find_mauve_sources]} then {
|
|
verbose "MAUVEDIR not set; not running Mauve tests"
|
|
return 1
|
|
}
|
|
|
|
# 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 libgcj_jar
|
|
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.jar are found
|
|
# before they're installed.
|
|
# Append -Wno-deprecated since Mauve tests lots of deprecated stuff.
|
|
set env(GCJ) "$GCJ_UNDER_TEST -Wno-deprecated -B$objdir/../ -I$libgcj_jar"
|
|
|
|
if {[catch {
|
|
system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve configure"
|
|
verbose "configure failed with $msg"
|
|
return 0
|
|
}
|
|
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
|
|
|
|
catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
|
|
|
|
if {[catch {
|
|
system "make KEYS=libgcj classes.stamp 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve build"
|
|
verbose "build failed with $msg"
|
|
return 0
|
|
}
|
|
pass "Mauve build"
|
|
|
|
set srcfile $full_srcdir/$subdir/DejaGNUTestHarness.java
|
|
if {! [bytecompile_file $srcfile [pwd] $env(MAUVEDIR):[pwd]]} then {
|
|
fail "Compile DejaGNUTestHarness.java"
|
|
return 0
|
|
}
|
|
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"]]
|
|
|
|
if {[string match "*libtool*" $compile_args]} {
|
|
set objext lo
|
|
} else {
|
|
set objext o
|
|
}
|
|
|
|
set ok 1
|
|
set objlist {}
|
|
foreach base [mauve_find_harness_files] {
|
|
set file $base.class
|
|
set obj $base.$objext
|
|
set x [libjava_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 0
|
|
}
|
|
|
|
set proc_ok 1
|
|
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
|
|
set this_olist {}
|
|
foreach obj $uses($file) {
|
|
set obj [file rootname $obj].$objext
|
|
lappend this_olist $obj
|
|
if {! [file exists $obj]} then {
|
|
verbose "compiling $obj for test of $class"
|
|
# The .class file does contain a $, but we can quote it between "'"s.
|
|
set srcfile [file rootname $obj].class
|
|
regsub -all "\\^" $srcfile "\$" srcfile
|
|
set x [libjava_prune_warnings \
|
|
[libjava_tcompile '[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 {
|
|
set proc_ok 0
|
|
continue
|
|
}
|
|
|
|
set x [libjava_prune_warnings \
|
|
[libjava_tcompile [concat $this_olist $objlist] \
|
|
$Executable executable $link_args]]
|
|
if {$x != ""} then {
|
|
set proc_ok 0
|
|
fail "Link for $class"
|
|
continue
|
|
}
|
|
pass "Link for $class"
|
|
|
|
set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|
"$env(MAUVEDIR) $class" ""]
|
|
|
|
# Extract pass/failure info from output.
|
|
foreach line [split [lindex $result 1] \n] {
|
|
if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
|
|
if {$what == "XFAIL" || $what == "XPASS"} then {
|
|
setup_xfail *-*-*
|
|
}
|
|
if {$what == "PASS" || $what == "XPASS"} then {
|
|
pass $msg
|
|
} else {
|
|
set proc_ok 0
|
|
fail $msg
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $proc_ok
|
|
}
|
|
|
|
# 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. Return 1 on success,
|
|
# 0 on any failure. If the tests are skipped, that is treated like
|
|
# success.
|
|
proc test_mauve_sim {} {
|
|
global srcdir subdir env
|
|
|
|
if {! [find_mauve_sources]} then {
|
|
verbose "MAUVEDIR not set; not running Mauve tests"
|
|
return 1
|
|
}
|
|
|
|
# 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 0
|
|
}
|
|
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
|
|
|
|
catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
|
|
|
|
if {[catch {
|
|
system "make KEYS=libgcj classes.stamp 2>&1"
|
|
} msg]} then {
|
|
fail "Mauve build"
|
|
verbose "build failed with $msg"
|
|
return 0
|
|
}
|
|
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 [mauve_find_harness_files] {
|
|
set file $base.class
|
|
set obj $base.o
|
|
set x [libjava_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 0
|
|
}
|
|
|
|
set proc_ok 1
|
|
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 [libjava_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 {
|
|
set proc_ok 0
|
|
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 0
|
|
}
|
|
|
|
set x [libjava_prune_warnings \
|
|
[target_compile DejaGNUTestHarness.class \
|
|
DejaGNUTestHarness.o object $compile_args]]
|
|
if {$x != ""} then {
|
|
fail "Compile DejaGNUTestHarness.java"
|
|
set proc_ok 0
|
|
continue
|
|
}
|
|
|
|
set x [libjava_prune_warnings \
|
|
[target_compile [concat $uses($file) $objlist] \
|
|
$Executable executable $link_args]]
|
|
if {$x != ""} then {
|
|
set proc_ok 0
|
|
fail "Link for $class"
|
|
continue
|
|
}
|
|
pass "Link for $class"
|
|
|
|
set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|
"$env(MAUVEDIR) $class" ""]
|
|
|
|
# Extract pass/failure info from output.
|
|
foreach line [split [lindex $result 1] \n] {
|
|
if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
|
|
if {$what == "XFAIL" || $what == "XPASS"} then {
|
|
setup_xfail *-*-*
|
|
}
|
|
if {$what == "PASS" || $what == "XPASS"} then {
|
|
pass $msg
|
|
} else {
|
|
set proc_ok 0
|
|
fail $msg
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
return $proc_ok
|
|
}
|
|
|
|
proc gcj_run_mauve_tests {} {
|
|
# 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] } {
|
|
set r [test_mauve_sim]
|
|
} else {
|
|
set r [test_mauve]
|
|
}
|
|
cd $here
|
|
|
|
if {$r} {
|
|
# No need to keep the build around. FIXME: this knows how the
|
|
# tests work. This whole file could use a rewrite.
|
|
system "rm -rf mauve-build"
|
|
}
|
|
}
|
|
|
|
gcj_run_mauve_tests
|