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.
11proc 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.
64proc 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.
79proc 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.
89proc 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.
265proc 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
427proc 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
446gcj_run_mauve_tests
447