| 1 | # Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003 Free Software Foundation.
|
|---|
| 2 | # Written by Tom Tromey <tromey@cygnus.com>.
|
|---|
| 3 | # Incorporate Mauve into libjava's DejaGNU test suite framework.
|
|---|
| 4 |
|
|---|
| 5 | # FIXME: should be able to compile from source as well as from .class.
|
|---|
| 6 |
|
|---|
| 7 |
|
|---|
| 8 | # Compute list of files to compile. Returns list of all files
|
|---|
| 9 | # representing classes that must be tested. Result parameter `uses'
|
|---|
| 10 | # maps source file names onto list of objects required for link.
|
|---|
| 11 | proc mauve_compute_uses {aName} {
|
|---|
| 12 | upvar $aName uses
|
|---|
| 13 | global env runtests
|
|---|
| 14 |
|
|---|
| 15 | set fd [open classes r]
|
|---|
| 16 | set line [read $fd]
|
|---|
| 17 | close $fd
|
|---|
| 18 |
|
|---|
| 19 | foreach item [split $line] {
|
|---|
| 20 | if {$item == ""} then {
|
|---|
| 21 | continue
|
|---|
| 22 | }
|
|---|
| 23 | set item [join [split $item .] /].java
|
|---|
| 24 |
|
|---|
| 25 | # User might have specified "mauve.exp=something.java".
|
|---|
| 26 | if {! [runtest_file_p $runtests $item]} {
|
|---|
| 27 | continue
|
|---|
| 28 | }
|
|---|
| 29 |
|
|---|
| 30 | # Look for Uses line in source file.
|
|---|
| 31 | set fd [open $env(MAUVEDIR)/$item r]
|
|---|
| 32 | set ufiles [list $item]
|
|---|
| 33 | set dir [file dirname $item]
|
|---|
| 34 | while {[gets $fd sline] != -1} {
|
|---|
| 35 | if {[regsub -- {^// Uses:} $sline {} sline]} then {
|
|---|
| 36 | foreach uf [split $sline] {
|
|---|
| 37 | if {$uf != ""} then {
|
|---|
| 38 | lappend ufiles $dir/$uf
|
|---|
| 39 | }
|
|---|
| 40 | }
|
|---|
| 41 | }
|
|---|
| 42 | }
|
|---|
| 43 | close $fd
|
|---|
| 44 |
|
|---|
| 45 | set uses($item) {}
|
|---|
| 46 | foreach file $ufiles {
|
|---|
| 47 | set file [file rootname $file].o
|
|---|
| 48 | lappend uses($item) $file
|
|---|
| 49 | # Now add all inner classes
|
|---|
| 50 | foreach inner [glob -nocomplain [file rootname $file]$*.class] {
|
|---|
| 51 | # Prevent excessive escaping by replacing $ with a ^ in the .o name
|
|---|
| 52 | set inner [file rootname $inner].o
|
|---|
| 53 | regsub -all "\\$" $inner "\^" inner
|
|---|
| 54 | lappend uses($item) $inner
|
|---|
| 55 | }
|
|---|
| 56 | }
|
|---|
| 57 | }
|
|---|
| 58 |
|
|---|
| 59 | return [lsort [array names uses]]
|
|---|
| 60 | }
|
|---|
| 61 |
|
|---|
| 62 | # Find Mauve sources. At end, env(MAUVEDIR) points to sources.
|
|---|
| 63 | # Returns 0 if sources not found, 1 otherwise.
|
|---|
| 64 | proc find_mauve_sources {} {
|
|---|
| 65 | global env srcdir
|
|---|
| 66 |
|
|---|
| 67 | if {[info exists env(MAUVEDIR)]} {
|
|---|
| 68 | return 1
|
|---|
| 69 | } elseif {[file isdirectory $srcdir/libjava.mauve/mauve]} {
|
|---|
| 70 | set env(MAUVEDIR) $srcdir/libjava.mauve/mauve
|
|---|
| 71 | return 1
|
|---|
| 72 | }
|
|---|
| 73 |
|
|---|
| 74 | return 0
|
|---|
| 75 | }
|
|---|
| 76 |
|
|---|
| 77 | # Run all the Mauve tests. Return 1 on success, 0 on any failure. If
|
|---|
| 78 | # the tests are skipped, that is treated like success.
|
|---|
| 79 | proc test_mauve {} {
|
|---|
| 80 | global srcdir objdir subdir env
|
|---|
| 81 |
|
|---|
| 82 | if {! [find_mauve_sources]} then {
|
|---|
| 83 | verbose "MAUVEDIR not set; not running Mauve tests"
|
|---|
| 84 | return 1
|
|---|
| 85 | }
|
|---|
| 86 |
|
|---|
| 87 | # Run in subdir so we don't overwrite our own Makefile.
|
|---|
| 88 | catch {system "rm -rf mauve-build"}
|
|---|
| 89 | file mkdir mauve-build
|
|---|
| 90 | # Some weirdness to set srcdir correctly.
|
|---|
| 91 | set here [pwd]
|
|---|
| 92 | cd $srcdir
|
|---|
| 93 | set full_srcdir [pwd]
|
|---|
| 94 | cd $here/mauve-build
|
|---|
| 95 |
|
|---|
| 96 | global env libgcj_jar
|
|---|
| 97 | global GCJ_UNDER_TEST
|
|---|
| 98 | global TOOL_EXECUTABLE
|
|---|
| 99 |
|
|---|
| 100 | if ![info exists GCJ_UNDER_TEST] {
|
|---|
| 101 | if [info exists TOOL_EXECUTABLE] {
|
|---|
| 102 | set GCJ_UNDER_TEST $TOOL_EXECUTABLE;
|
|---|
| 103 | } else {
|
|---|
| 104 | if [info exists env(GCJ)] {
|
|---|
| 105 | set GCJ_UNDER_TEST env(GCJ)
|
|---|
| 106 | } else {
|
|---|
| 107 | set GCJ_UNDER_TEST "[find_gcj]"
|
|---|
| 108 | }
|
|---|
| 109 | }
|
|---|
| 110 | }
|
|---|
| 111 |
|
|---|
| 112 | # Append -B and -I so that libgcj.spec and libgcj.jar are found
|
|---|
| 113 | # before they're installed.
|
|---|
| 114 | set env(GCJ) "$GCJ_UNDER_TEST -B$objdir/../ -I$libgcj_jar"
|
|---|
| 115 |
|
|---|
| 116 | if {[catch {
|
|---|
| 117 | system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
|
|---|
| 118 | } msg]} then {
|
|---|
| 119 | fail "Mauve configure"
|
|---|
| 120 | verbose "configure failed with $msg"
|
|---|
| 121 | return 0
|
|---|
| 122 | }
|
|---|
| 123 | pass "Mauve configure"
|
|---|
| 124 |
|
|---|
| 125 | # Copy appropriate tags file locally.
|
|---|
| 126 | set fd [open $full_srcdir/../mauve-libgcj r]
|
|---|
| 127 | set c [read $fd]
|
|---|
| 128 | close $fd
|
|---|
| 129 | set fd [open mauve-libgcj w]
|
|---|
| 130 | puts -nonewline $fd $c
|
|---|
| 131 | close $fd
|
|---|
| 132 |
|
|---|
| 133 | catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
|
|---|
| 134 |
|
|---|
| 135 | if {[catch {
|
|---|
| 136 | system "make KEYS=libgcj classes.stamp 2>&1"
|
|---|
| 137 | } msg]} then {
|
|---|
| 138 | fail "Mauve build"
|
|---|
| 139 | verbose "build failed with $msg"
|
|---|
| 140 | return 0
|
|---|
| 141 | }
|
|---|
| 142 | pass "Mauve build"
|
|---|
| 143 |
|
|---|
| 144 | set srcfile $full_srcdir/$subdir/DejaGNUTestHarness.java
|
|---|
| 145 | if {! [bytecompile_file $srcfile [pwd] $env(MAUVEDIR):[pwd]]} then {
|
|---|
| 146 | fail "Compile DejaGNUTestHarness.java"
|
|---|
| 147 | return 0
|
|---|
| 148 | }
|
|---|
| 149 | pass "Compile DejaGNUTestHarness.java"
|
|---|
| 150 |
|
|---|
| 151 | # Compute list of files to test, and also all files to build.
|
|---|
| 152 | set choices [mauve_compute_uses uses]
|
|---|
| 153 |
|
|---|
| 154 | # Compute flags to use to do the build.
|
|---|
| 155 | set compile_args [libjava_arguments]
|
|---|
| 156 | set link_args [concat [libjava_arguments link] \
|
|---|
| 157 | [list "additional_flags=--main=DejaGNUTestHarness"]]
|
|---|
| 158 |
|
|---|
| 159 | set ok 1
|
|---|
| 160 | set objlist {}
|
|---|
| 161 | foreach base {DejaGNUTestHarness gnu/testlet/SimpleTestHarness gnu/testlet/TestHarness gnu/testlet/Testlet gnu/testlet/ResourceNotFoundException gnu/testlet/config} {
|
|---|
| 162 | set file $base.class
|
|---|
| 163 | set obj $base.o
|
|---|
| 164 | set x [libjava_prune_warnings \
|
|---|
| 165 | [target_compile [pwd]/$file $obj object $compile_args]]
|
|---|
| 166 | if {$x != ""} then {
|
|---|
| 167 | fail "Compile $obj"
|
|---|
| 168 | set ok 0
|
|---|
| 169 | } else {
|
|---|
| 170 | pass "Compile $obj"
|
|---|
| 171 | }
|
|---|
| 172 | lappend objlist $obj
|
|---|
| 173 | }
|
|---|
| 174 | if {! $ok} then {
|
|---|
| 175 | return 0
|
|---|
| 176 | }
|
|---|
| 177 |
|
|---|
| 178 | set proc_ok 1
|
|---|
| 179 | set Executable DejaGNUTestHarness
|
|---|
| 180 | foreach file $choices {
|
|---|
| 181 | # Turn `java/lang/Foo.java' into `java.lang.Foo'.
|
|---|
| 182 | set class [file rootname $file]
|
|---|
| 183 | regsub -all -- / $class . class
|
|---|
| 184 |
|
|---|
| 185 | set ok 1
|
|---|
| 186 | foreach obj $uses($file) {
|
|---|
| 187 | if {! [file exists $obj]} then {
|
|---|
| 188 | verbose "compiling $obj for test of $class"
|
|---|
| 189 | # The .class file does contain a $, but we can quote it between "'"s.
|
|---|
| 190 | set srcfile [file rootname $obj].class
|
|---|
| 191 | regsub -all "\\^" $srcfile "\$" srcfile
|
|---|
| 192 | set x [libjava_prune_warnings \
|
|---|
| 193 | [libjava_tcompile '[pwd]/$srcfile' $obj object $compile_args]]
|
|---|
| 194 | if {$x != ""} then {
|
|---|
| 195 | fail "Compile $obj for $class"
|
|---|
| 196 | set ok 0
|
|---|
| 197 | break
|
|---|
| 198 | }
|
|---|
| 199 | pass "Compile $obj for $class"
|
|---|
| 200 | }
|
|---|
| 201 | }
|
|---|
| 202 | if {! $ok} then {
|
|---|
| 203 | set proc_ok 0
|
|---|
| 204 | continue
|
|---|
| 205 | }
|
|---|
| 206 |
|
|---|
| 207 | set x [libjava_prune_warnings \
|
|---|
| 208 | [libjava_tcompile [concat $uses($file) $objlist] \
|
|---|
| 209 | $Executable executable $link_args]]
|
|---|
| 210 | if {$x != ""} then {
|
|---|
| 211 | set proc_ok 0
|
|---|
| 212 | fail "Link for $class"
|
|---|
| 213 | continue
|
|---|
| 214 | }
|
|---|
| 215 | pass "Link for $class"
|
|---|
| 216 |
|
|---|
| 217 | set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|---|
| 218 | "$env(MAUVEDIR) $class" ""]
|
|---|
| 219 |
|
|---|
| 220 | # Extract pass/failure info from output.
|
|---|
| 221 | foreach line [split [lindex $result 1] \n] {
|
|---|
| 222 | if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
|
|---|
| 223 | if {$what == "XFAIL" || $what == "XPASS"} then {
|
|---|
| 224 | setup_xfail *-*-*
|
|---|
| 225 | }
|
|---|
| 226 | if {$what == "PASS" || $what == "XPASS"} then {
|
|---|
| 227 | pass $msg
|
|---|
| 228 | } else {
|
|---|
| 229 | set proc_ok 0
|
|---|
| 230 | fail $msg
|
|---|
| 231 | }
|
|---|
| 232 | }
|
|---|
| 233 | }
|
|---|
| 234 | }
|
|---|
| 235 |
|
|---|
| 236 | return $proc_ok
|
|---|
| 237 | }
|
|---|
| 238 |
|
|---|
| 239 | # Run all the Mauve tests in a sim environment. In this case, the
|
|---|
| 240 | # program cannot use argv[] because there's no way to pass in the
|
|---|
| 241 | # command line, so tha name of the class to test is substituted by
|
|---|
| 242 | # patching the source of the DejaGNUTestHarness. Return 1 on success,
|
|---|
| 243 | # 0 on any failure. If the tests are skipped, that is treated like
|
|---|
| 244 | # success.
|
|---|
| 245 | proc test_mauve_sim {} {
|
|---|
| 246 | global srcdir subdir env
|
|---|
| 247 |
|
|---|
| 248 | if {! [find_mauve_sources]} then {
|
|---|
| 249 | verbose "MAUVEDIR not set; not running Mauve tests"
|
|---|
| 250 | return 1
|
|---|
| 251 | }
|
|---|
| 252 |
|
|---|
| 253 | # Run in subdir so we don't overwrite our own Makefile.
|
|---|
| 254 | catch {system "rm -rf mauve-build"}
|
|---|
| 255 | file mkdir mauve-build
|
|---|
| 256 | # Some weirdness to set srcdir correctly.
|
|---|
| 257 | set here [pwd]
|
|---|
| 258 | cd $srcdir
|
|---|
| 259 | set full_srcdir [pwd]
|
|---|
| 260 | cd $here/mauve-build
|
|---|
| 261 |
|
|---|
| 262 | if {[catch {
|
|---|
| 263 | system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
|
|---|
| 264 | } msg]} then {
|
|---|
| 265 | fail "Mauve configure"
|
|---|
| 266 | verbose "configure failed with $msg"
|
|---|
| 267 | return 0
|
|---|
| 268 | }
|
|---|
| 269 | pass "Mauve configure"
|
|---|
| 270 |
|
|---|
| 271 | # Copy appropriate tags file locally.
|
|---|
| 272 | set fd [open $full_srcdir/../mauve-libgcj r]
|
|---|
| 273 | set c [read $fd]
|
|---|
| 274 | close $fd
|
|---|
| 275 | set fd [open mauve-libgcj w]
|
|---|
| 276 | puts -nonewline $fd $c
|
|---|
| 277 | close $fd
|
|---|
| 278 |
|
|---|
| 279 | catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
|
|---|
| 280 |
|
|---|
| 281 | if {[catch {
|
|---|
| 282 | system "make KEYS=libgcj classes.stamp 2>&1"
|
|---|
| 283 | } msg]} then {
|
|---|
| 284 | fail "Mauve build"
|
|---|
| 285 | verbose "build failed with $msg"
|
|---|
| 286 | return 0
|
|---|
| 287 | }
|
|---|
| 288 | pass "Mauve build"
|
|---|
| 289 |
|
|---|
| 290 | # Compute list of files to test, and also all files to build.
|
|---|
| 291 | set choices [mauve_compute_uses uses]
|
|---|
| 292 |
|
|---|
| 293 | # Compute flags to use to do the build.
|
|---|
| 294 | set compile_args [libjava_arguments]
|
|---|
| 295 | set link_args [concat [libjava_arguments link] \
|
|---|
| 296 | [list "additional_flags=--main=DejaGNUTestHarness"]]
|
|---|
| 297 |
|
|---|
| 298 | set ok 1
|
|---|
| 299 | set objlist {}
|
|---|
| 300 | foreach base {gnu/testlet/SimpleTestHarness gnu/testlet/TestHarness \
|
|---|
| 301 | gnu/testlet/Testlet gnu/testlet/ResourceNotFoundException \
|
|---|
| 302 | gnu/testlet/config} {
|
|---|
| 303 | set file $base.class
|
|---|
| 304 | set obj $base.o
|
|---|
| 305 | set x [libjava_prune_warnings \
|
|---|
| 306 | [target_compile [pwd]/$file $obj object $compile_args]]
|
|---|
| 307 | if {$x != ""} then {
|
|---|
| 308 | fail "Compile $obj"
|
|---|
| 309 | set ok 0
|
|---|
| 310 | } else {
|
|---|
| 311 | pass "Compile $obj"
|
|---|
| 312 | }
|
|---|
| 313 | lappend objlist $obj
|
|---|
| 314 | }
|
|---|
| 315 | if {! $ok} then {
|
|---|
| 316 | return 0
|
|---|
| 317 | }
|
|---|
| 318 |
|
|---|
| 319 | lappend objlist gnu/testlet/DejaGNUTestHarness.o
|
|---|
| 320 |
|
|---|
| 321 | set proc_ok 1
|
|---|
| 322 | set Executable DejaGNUTestHarness
|
|---|
| 323 | foreach file $choices {
|
|---|
| 324 | # Turn `java/lang/Foo.java' into `java.lang.Foo'.
|
|---|
| 325 |
|
|---|
| 326 | set class [file rootname $file]
|
|---|
| 327 | regsub -all -- / $class . class
|
|---|
| 328 |
|
|---|
| 329 | set ok 1
|
|---|
| 330 | foreach obj $uses($file) {
|
|---|
| 331 | if {! [file exists $obj]} then {
|
|---|
| 332 | verbose "compiling $obj for test of $class"
|
|---|
| 333 | set srcfile [file rootname $obj].class
|
|---|
| 334 | set x [libjava_prune_warnings \
|
|---|
| 335 | [target_compile [pwd]/$srcfile $obj object $compile_args]]
|
|---|
| 336 | if {$x != ""} then {
|
|---|
| 337 | fail "Compile $obj for $class"
|
|---|
| 338 | set ok 0
|
|---|
| 339 | break
|
|---|
| 340 | }
|
|---|
| 341 | pass "Compile $obj for $class"
|
|---|
| 342 | }
|
|---|
| 343 | }
|
|---|
| 344 | if {! $ok} then {
|
|---|
| 345 | set proc_ok 0
|
|---|
| 346 | continue
|
|---|
| 347 | }
|
|---|
| 348 |
|
|---|
| 349 | set infile $full_srcdir/$subdir/DejaGNUTestHarness.java
|
|---|
| 350 | set srcfile DejaGNUTestHarness.java
|
|---|
| 351 | set f [open $infile r]
|
|---|
| 352 | set d [open gnu/testlet/$srcfile w]
|
|---|
| 353 | while {[gets $f line] >= 0} {
|
|---|
| 354 | if [regexp {harness\.runtest \(args\[1\]\)} $line] then {
|
|---|
| 355 | regsub {args\[1\]} $line "\"$class\"" out
|
|---|
| 356 | } else {
|
|---|
| 357 | set out $line
|
|---|
| 358 | }
|
|---|
| 359 | puts $d $out
|
|---|
| 360 | }
|
|---|
| 361 | close $f
|
|---|
| 362 | close $d
|
|---|
| 363 |
|
|---|
| 364 | if {! [bytecompile_file [pwd]/gnu/testlet/$srcfile [pwd]/gnu/testlet \
|
|---|
| 365 | $env(MAUVEDIR):[pwd]]} then {
|
|---|
| 366 | fail "Compile DejaGNUTestHarness.java"
|
|---|
| 367 | return 0
|
|---|
| 368 | }
|
|---|
| 369 |
|
|---|
| 370 | set x [libjava_prune_warnings \
|
|---|
| 371 | [target_compile gnu/testlet/DejaGNUTestHarness.class \
|
|---|
| 372 | gnu/testlet/DejaGNUTestHarness.o object $compile_args]]
|
|---|
| 373 | if {$x != ""} then {
|
|---|
| 374 | fail "Compile DejaGNUTestHarness.java"
|
|---|
| 375 | set proc_ok 0
|
|---|
| 376 | continue
|
|---|
| 377 | }
|
|---|
| 378 |
|
|---|
| 379 | set x [libjava_prune_warnings \
|
|---|
| 380 | [target_compile [concat $uses($file) $objlist] \
|
|---|
| 381 | $Executable executable $link_args]]
|
|---|
| 382 | if {$x != ""} then {
|
|---|
| 383 | set proc_ok 0
|
|---|
| 384 | fail "Link for $class"
|
|---|
| 385 | continue
|
|---|
| 386 | }
|
|---|
| 387 | pass "Link for $class"
|
|---|
| 388 |
|
|---|
| 389 | set result [libjava_load [pwd]/DejaGNUTestHarness \
|
|---|
| 390 | "$env(MAUVEDIR) $class" ""]
|
|---|
| 391 |
|
|---|
| 392 | # Extract pass/failure info from output.
|
|---|
| 393 | foreach line [split [lindex $result 1] \n] {
|
|---|
| 394 | if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
|
|---|
| 395 | if {$what == "XFAIL" || $what == "XPASS"} then {
|
|---|
| 396 | setup_xfail *-*-*
|
|---|
| 397 | }
|
|---|
| 398 | if {$what == "PASS" || $what == "XPASS"} then {
|
|---|
| 399 | pass $msg
|
|---|
| 400 | } else {
|
|---|
| 401 | set proc_ok 0
|
|---|
| 402 | fail $msg
|
|---|
| 403 | }
|
|---|
| 404 | }
|
|---|
| 405 | }
|
|---|
| 406 | }
|
|---|
| 407 |
|
|---|
| 408 | return $proc_ok
|
|---|
| 409 | }
|
|---|
| 410 |
|
|---|
| 411 | proc gcj_run_mauve_tests {} {
|
|---|
| 412 | # The test_mauve* procs will change the current directory. It's
|
|---|
| 413 | # simpler to fix this up here than to keep track of this in the
|
|---|
| 414 | # procs.
|
|---|
| 415 | set here [pwd]
|
|---|
| 416 | if { [board_info target exists is_simulator] } {
|
|---|
| 417 | set r [test_mauve_sim]
|
|---|
| 418 | } else {
|
|---|
| 419 | set r [test_mauve]
|
|---|
| 420 | }
|
|---|
| 421 | cd $here
|
|---|
| 422 |
|
|---|
| 423 | if {$r} {
|
|---|
| 424 | # No need to keep the build around. FIXME: this knows how the
|
|---|
| 425 | # tests work. This whole file could use a rewrite.
|
|---|
| 426 | system "rm -rf mauve-build"
|
|---|
| 427 | }
|
|---|
| 428 | }
|
|---|
| 429 |
|
|---|
| 430 | gcj_run_mauve_tests
|
|---|
