123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447 |
- # 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
|