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