OSDN Git Service

PR libgcj/27171:
[pf3gnuchains/gcc-fork.git] / libjava / testsuite / libjava.mauve / mauve.exp
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 # Find all the harness files and return a list of them, with no
78 # suffix.
79 proc mauve_find_harness_files {} {
80   set result {}
81   foreach file [glob -nocomplain -- *.class gnu/testlet/*.class] {
82     lappend result [file root $file]
83   }
84   return $result
85 }
86
87 # Run all the Mauve tests.  Return 1 on success, 0 on any failure.  If
88 # the tests are skipped, that is treated like success.
89 proc test_mauve {} {
90   global srcdir objdir subdir env
91
92   if {! [find_mauve_sources]} then {
93     verbose "MAUVEDIR not set; not running Mauve tests"
94     return 1
95   }
96
97   # Run in subdir so we don't overwrite our own Makefile.
98   catch {system "rm -rf mauve-build"}
99   file mkdir mauve-build
100   # Some weirdness to set srcdir correctly.
101   set here [pwd]
102   cd $srcdir
103   set full_srcdir [pwd]
104   cd $here/mauve-build
105
106   global env libgcj_jar
107   global GCJ_UNDER_TEST
108   global TOOL_EXECUTABLE
109
110   if ![info exists GCJ_UNDER_TEST] {
111     if [info exists TOOL_EXECUTABLE] {
112       set GCJ_UNDER_TEST $TOOL_EXECUTABLE;
113     } else {
114       if [info exists env(GCJ)] {
115         set GCJ_UNDER_TEST env(GCJ)
116       } else {
117         set GCJ_UNDER_TEST "[find_gcj]"
118       }
119     }
120   }
121
122   # Append -B and -I so that libgcj.spec and libgcj.jar are found
123   # before they're installed.
124   # Append -Wno-deprecated since Mauve tests lots of deprecated stuff.
125   set env(GCJ) "$GCJ_UNDER_TEST -Wno-deprecated -B$objdir/../ -I$libgcj_jar"
126
127   if {[catch {
128     system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
129   } msg]} then {
130     fail "Mauve configure"
131     verbose "configure failed with $msg"
132     return 0
133   }
134   pass "Mauve configure"
135
136   # Copy appropriate tags file locally.
137   set fd [open $full_srcdir/../mauve-libgcj r]
138   set c [read $fd]
139   close $fd
140   set fd [open mauve-libgcj w]
141   puts -nonewline $fd $c
142   close $fd
143
144   catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
145
146   if {[catch {
147     system "make KEYS=libgcj classes.stamp 2>&1"
148   } msg]} then {
149     fail "Mauve build"
150     verbose "build failed with $msg"
151     return 0
152   }
153   pass "Mauve build"
154
155   set srcfile $full_srcdir/$subdir/DejaGNUTestHarness.java
156   if {! [bytecompile_file $srcfile [pwd] $env(MAUVEDIR):[pwd]]} then {
157     fail "Compile DejaGNUTestHarness.java"
158     return 0
159   }
160   pass "Compile DejaGNUTestHarness.java"
161
162   # Compute list of files to test, and also all files to build.
163   set choices [mauve_compute_uses uses]
164
165   # Compute flags to use to do the build.
166   set compile_args [libjava_arguments]
167   set link_args [concat [libjava_arguments link] \
168                    [list "additional_flags=--main=DejaGNUTestHarness"]]
169
170   if {[string match "*libtool*" $compile_args]} {
171     set objext lo
172   } else {
173     set objext o
174   }
175
176   set ok 1
177   set objlist {}
178   foreach base [mauve_find_harness_files] {
179     set file $base.class
180     set obj $base.$objext
181     set x [libjava_prune_warnings \
182              [target_compile [pwd]/$file $obj object $compile_args]]
183     if {$x != ""} then {
184       fail "Compile $obj"
185       set ok 0
186     } else {
187       pass "Compile $obj"
188     }
189     lappend objlist $obj
190   }
191   if {! $ok} then {
192     return 0
193   }
194
195   set proc_ok 1
196   set Executable DejaGNUTestHarness
197   foreach file $choices {
198     # Turn `java/lang/Foo.java' into `java.lang.Foo'.
199     set class [file rootname $file]
200     regsub -all -- / $class . class
201
202     set ok 1
203     set this_olist {}
204     foreach obj $uses($file) {
205       set obj [file rootname $obj].$objext
206       lappend this_olist $obj
207       if {! [file exists $obj]} then {
208         verbose "compiling $obj for test of $class"
209         # The .class file does contain a $, but we can quote it between "'"s.
210         set srcfile [file rootname $obj].class
211         regsub -all "\\^" $srcfile "\$" srcfile
212         set x [libjava_prune_warnings \
213                  [libjava_tcompile '[pwd]/$srcfile' $obj object $compile_args]]
214         if {$x != ""} then {
215           fail "Compile $obj for $class"
216           set ok 0
217           break
218         }
219         pass "Compile $obj for $class"
220       }
221     }
222     if {! $ok} then {
223       set proc_ok 0
224       continue
225     }
226
227     set x [libjava_prune_warnings \
228              [libjava_tcompile [concat $this_olist $objlist] \
229                 $Executable executable $link_args]]
230     if {$x != ""} then {
231       set proc_ok 0
232       fail "Link for $class"
233       continue
234     }
235     pass "Link for $class"
236
237     set result [libjava_load [pwd]/DejaGNUTestHarness \
238                   "$env(MAUVEDIR) $class" ""]
239
240     # Extract pass/failure info from output.
241     foreach line [split [lindex $result 1] \n] {
242       if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
243         if {$what == "XFAIL" || $what == "XPASS"} then {
244           setup_xfail *-*-*
245         }
246         if {$what == "PASS" || $what == "XPASS"} then {
247           pass $msg
248         } else {
249           set proc_ok 0
250           fail $msg
251         }
252       }
253     }
254   }
255
256   return $proc_ok
257 }
258
259 # Run all the Mauve tests in a sim environment.  In this case, the
260 # program cannot use argv[] because there's no way to pass in the
261 # command line, so tha name of the class to test is substituted by
262 # patching the source of the DejaGNUTestHarness.  Return 1 on success,
263 # 0 on any failure.  If the tests are skipped, that is treated like
264 # success.
265 proc test_mauve_sim {} {
266   global srcdir subdir env
267
268   if {! [find_mauve_sources]} then {
269     verbose "MAUVEDIR not set; not running Mauve tests"
270     return 1
271   }
272
273   # Run in subdir so we don't overwrite our own Makefile.
274   catch {system "rm -rf mauve-build"}
275   file mkdir mauve-build
276   # Some weirdness to set srcdir correctly.
277   set here [pwd]
278   cd $srcdir
279   set full_srcdir [pwd]
280   cd $here/mauve-build
281
282   if {[catch {
283     system "$env(MAUVEDIR)/configure --with-gcj 2>&1"
284   } msg]} then {
285     fail "Mauve configure"
286     verbose "configure failed with $msg"
287     return 0
288   }
289   pass "Mauve configure"
290
291   # Copy appropriate tags file locally.
292   set fd [open $full_srcdir/../mauve-libgcj r]
293   set c [read $fd]
294   close $fd
295   set fd [open mauve-libgcj w]
296   puts -nonewline $fd $c
297   close $fd
298
299   catch {system "ln -s $full_srcdir/libjava.mauve/xfails xfails"}
300
301   if {[catch {
302     system "make KEYS=libgcj classes.stamp 2>&1"
303   } msg]} then {
304     fail "Mauve build"
305     verbose "build failed with $msg"
306     return 0
307   }
308   pass "Mauve build"
309
310   # Compute list of files to test, and also all files to build.
311   set choices [mauve_compute_uses uses]
312
313   # Compute flags to use to do the build.
314   set compile_args [libjava_arguments]
315   set link_args [concat [libjava_arguments link] \
316                    [list "additional_flags=--main=DejaGNUTestHarness"]]
317
318   set ok 1
319   set objlist {}
320   foreach base [mauve_find_harness_files] {
321     set file $base.class
322     set obj $base.o
323     set x [libjava_prune_warnings \
324              [target_compile [pwd]/$file $obj object $compile_args]]
325     if {$x != ""} then {
326       fail "Compile $obj"
327       set ok 0
328     } else {
329       pass "Compile $obj"
330     }
331     lappend objlist $obj
332   }
333   if {! $ok} then {
334     return 0
335   }
336
337   set proc_ok 1
338   set Executable DejaGNUTestHarness
339   foreach file $choices {
340     # Turn `java/lang/Foo.java' into `java.lang.Foo'.
341     
342     set class [file rootname $file]
343     regsub -all -- / $class . class
344
345     set ok 1
346     foreach obj $uses($file) {
347       if {! [file exists $obj]} then {
348         verbose "compiling $obj for test of $class"
349         set srcfile [file rootname $obj].class
350         set x [libjava_prune_warnings \
351                  [target_compile [pwd]/$srcfile $obj object $compile_args]]
352         if {$x != ""} then {
353           fail "Compile $obj for $class"
354           set ok 0
355           break
356         }
357         pass "Compile $obj for $class"
358       }
359     }
360     if {! $ok} then {
361       set proc_ok 0
362       continue
363     }
364
365     set infile $full_srcdir/$subdir/DejaGNUTestHarness.java
366     set srcfile DejaGNUTestHarness.java
367     set f [open $infile r]
368     set d [open gnu/testlet/$srcfile w]
369     while {[gets $f line] >= 0} {
370         if [regexp {harness\.runtest \(args\[1\]\)} $line] then {
371             regsub {args\[1\]} $line "\"$class\"" out
372         } else {
373             set out $line
374         }
375         puts $d $out
376     }
377     close $f
378     close $d
379
380     if {! [bytecompile_file [pwd]/gnu/testlet/$srcfile [pwd]/gnu/testlet \
381                $env(MAUVEDIR):[pwd]]} then {
382         fail "Compile DejaGNUTestHarness.java"
383         return 0
384     }
385
386     set x [libjava_prune_warnings \
387              [target_compile DejaGNUTestHarness.class \
388                 DejaGNUTestHarness.o object $compile_args]]
389     if {$x != ""} then {
390         fail "Compile DejaGNUTestHarness.java"
391         set proc_ok 0
392         continue
393     }
394
395     set x [libjava_prune_warnings \
396              [target_compile [concat $uses($file) $objlist] \
397                 $Executable executable $link_args]]
398     if {$x != ""} then {
399       set proc_ok 0
400       fail "Link for $class"
401       continue
402     }
403     pass "Link for $class"
404
405     set result [libjava_load [pwd]/DejaGNUTestHarness \
406                   "$env(MAUVEDIR) $class" ""]
407
408     # Extract pass/failure info from output.
409     foreach line [split [lindex $result 1] \n] {
410       if {[regexp -- {^(PASS|FAIL|XFAIL|XPASS): (.*)$} $line ignore what msg]} then {
411         if {$what == "XFAIL" || $what == "XPASS"} then {
412           setup_xfail *-*-*
413         }
414         if {$what == "PASS" || $what == "XPASS"} then {
415           pass $msg
416         } else {
417           set proc_ok 0
418           fail $msg
419         }
420       }
421     }
422   }
423
424   return $proc_ok
425 }
426
427 proc gcj_run_mauve_tests {} {
428   # The test_mauve* procs will change the current directory.  It's
429   # simpler to fix this up here than to keep track of this in the
430   # procs.
431   set here [pwd]
432   if { [board_info target exists is_simulator] } {
433     set r [test_mauve_sim]
434   } else {
435     set r [test_mauve]
436   }
437   cd $here
438
439   if {$r} {
440     # No need to keep the build around.  FIXME: this knows how the
441     # tests work.  This whole file could use a rewrite.
442     system "rm -rf mauve-build"
443   }
444 }
445
446 gcj_run_mauve_tests