OSDN Git Service

2005-03-11 Andreas Tobler <a.tobler@schweiz.ch>
[pf3gnuchains/gcc-fork.git] / libjava / testsuite / lib / libjava.exp
1 # Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004 Free Software Foundation
2
3 proc load_gcc_lib { filename } {
4     global srcdir
5     load_file $srcdir/../../gcc/testsuite/lib/$filename
6 }
7
8 load_lib libgloss.exp
9 load_gcc_lib target-libpath.exp
10
11 # GCJ_UNDER_TEST is the compiler under test.
12
13 global tmpdir
14
15 if ![info exists tmpdir] {
16     set tmpdir "/tmp"
17 }
18
19 # This is like `prune_warnings', but it also prunes away a warning
20 # from the bytecode front end that we don't care about.
21 proc libjava_prune_warnings {text} {
22     set text [prune_warnings $text]
23     set tlist [split $text \n]
24     set len [llength $tlist]
25     for {set i [expr {$len - 1}]} {$i >= 2} {incr i -1} {
26         if {[string match "*unreachable bytecode*" [lindex $tlist $i]]} {
27             # Delete this line, all other unreachable warnings and the previous
28             # two lines containing the method and class.
29             set j [expr {$i - 1}]
30             while {[string match "*unreachable bytecode*" [lindex $tlist $j]]} {
31                 incr j -1
32             }
33             incr j -1
34             set tlist [lreplace $tlist $j $i]
35             set i $j
36         }
37     }
38     return [join $tlist \n]
39 }
40
41 # This is like `target_compile' but it does some surgery to work
42 # around stupid DejaGNU bugs.  In particular DejaGNU has very poor
43 # quoting, so for instance a `$' will be re-evaluated at spawn time.
44 # We don't want that.
45 proc libjava_tcompile {source destfile type options} {
46     # This strange-looking expression really does quote the `$'.
47     regsub -all -- {\$} $source {\$} source
48     regsub -all -- {\$} $destfile {\$} destfile
49     return [target_compile $source $destfile $type $options]
50 }
51
52 # Read an `xfail' file if it exists.  Returns a list of xfail tokens.
53 proc libjava_read_xfail {file} {
54     if {! [file exists $file]} {
55         return ""
56     }
57     set fd [open $file r]
58     set tokens [string trim [read $fd]]
59     close $fd
60     return $tokens
61 }
62
63 # Find a particular executable.  FIXME: this relies on DejaGnu
64 # internals.  These should probably be exposed in a better way.
65 proc libjava_find_program {prog} {
66     global tool_root_dir
67
68     set file [lookfor_file $tool_root_dir $prog]
69     if { $file == "" } {
70         set file [lookfor_file $tool_root_dir gcc/$prog];
71     }
72     if {$file == ""} {
73         set file $prog
74     }
75     return $file
76 }
77
78 # Find `jv-scan'.
79 proc find_jvscan {} {
80     return [libjava_find_program jv-scan]
81 }
82
83 # Find `gcjh'.
84 proc find_gcjh {} {
85     return [libjava_find_program gcjh]
86 }
87
88 proc find_javac {} {
89     global SUN_JAVAC GCJ_UNDER_TEST env libgcj_jar
90     # If JDK doesn't run on your platform but some other
91     # JDK-compatible javac does, you may set SUN_JAVAC to point to it.
92     # One of the most important properties of a SUN_JAVAC is that it
93     # must create class-files even for classes that have not been
94     # specified in the command line, but that were needed to compile
95     # those that have.  For example, Pizza won't do it, but you can
96     # use `kaffe sun.tools.javac.Main', if you have Sun's classes.zip
97     # in the kaffe's default search path.
98     if {![info exists SUN_JAVAC]} {
99         if {[info exists env(SUN_JAVAC)]} {
100             set SUN_JAVAC $env(SUN_JAVAC)
101         } else {
102             set SUN_JAVAC "$GCJ_UNDER_TEST -C -I$libgcj_jar"
103         }
104     }
105     return $SUN_JAVAC
106 }
107
108 proc bytecompile_file { file objdir {classpath {}} } {
109     global env
110     set dirname [file dirname $file]
111
112     set javac [find_javac]
113     if {$classpath != ""} then {
114         set env(CLASSPATH) $classpath
115     }
116     set here [pwd]
117     cd $dirname
118     send_log "byte compile: $javac -g [list $file] -d $objdir 2>@ stdout\n"
119     if {[catch {
120         set q [eval exec "$javac -g [list $file] -d $objdir 2>@ stdout"]
121     } msg]} then {
122         send_log "couldn't compile $file: $msg\n"
123         set r 0
124     } else {
125         set r 1
126     }
127     cd $here
128     return $r
129 }
130
131 set libjava_initialized 0
132
133 #
134 # Build the status wrapper library as needed.
135 #
136 proc libjava_init { args } {
137     global wrapper_file;
138     global wrap_compile_flags;
139     global libjava_initialized libjava_uses_threads
140     global GCJ_UNDER_TEST
141     global TOOL_EXECUTABLE
142     global env objdir
143     global env libgcj_jar
144     global tool_root_dir
145     global libjava_libgcc_s_path
146     global target_triplet
147
148     # We set LC_ALL and LANG to C so that we get the same error messages as expected.
149     setenv LC_ALL C
150     setenv LANG C
151
152     if { $libjava_initialized == 1 } { return; }
153
154     if ![info exists GCJ_UNDER_TEST] {
155         if [info exists TOOL_EXECUTABLE] {
156             set GCJ_UNDER_TEST $TOOL_EXECUTABLE;
157         } else {
158             if [info exists env(GCJ)] {
159                 set GCJ_UNDER_TEST $env(GCJ)
160             } else {
161                 set GCJ_UNDER_TEST "[find_gcj]"
162             }
163         }
164     }
165
166     # Find the libgcj jar file.
167     set libgcj_jar [glob $objdir/../libgcj-*.jar]
168     verbose "jar file is $libgcj_jar"
169
170     # FIXME: This finds libgcj.spec for the default multilib.
171     # If thread models differ between multilibs, this has to be moved
172     # to libjava_arguments
173     set specdir [libjava_find_spec]
174
175     # The -B is so we find libgcj.spec.
176     set text [eval exec "$GCJ_UNDER_TEST -B$specdir -v 2>@ stdout"]
177     regexp -- "Thread model: (\[^\n\]+)\n" $text ignore model
178     set libjava_uses_threads [expr {! ($model == "no"
179                                        || $model == "none"
180                                        || $model == "single")}]
181
182     # Always set encoding used by gcj.
183     append GCJ_UNDER_TEST " --encoding=UTF-8"
184
185     set wrapper_file "";
186     set wrap_compile_flags "";
187     if [target_info exists needs_status_wrapper] {
188         set result [build_wrapper "testglue.o"];
189         if { $result != "" } {
190             set wrapper_file [lindex $result 0];
191             set wrap_compile_flags [lindex $result 1];
192         } else {
193             warning "Status wrapper failed to build."
194         }
195     }
196
197     # Finally, add the gcc build directory so that we can find the
198     # shared libgcc.  This, like much of dejagnu, is hideous.
199     set libjava_libgcc_s_path {}
200
201     if { [istarget "*-*-darwin*"] } {
202         set so_extension "dylib"
203     } else {
204         set so_extension "so"
205     }
206     set gccdir [lookfor_file $tool_root_dir gcc/libgcc_s.${so_extension}]
207     if {$gccdir != ""} {
208         set gccdir [file dirname $gccdir]
209         lappend libjava_libgcc_s_path $gccdir
210         verbose "libjava_libgcc_s_path = $libjava_libgcc_s_path"
211         set compiler ${gccdir}/xgcc
212         if { [is_remote host] == 0 && [which $compiler] != 0 } {
213             foreach i "[exec $compiler --print-multi-lib]" {
214                 set mldir ""
215                 regexp -- "\[a-z0-9=/\.-\]*;" $i mldir
216                 set mldir [string trimright $mldir "\;@"]
217                 if { "$mldir" == "." } {
218                     continue
219                 }
220                 if { [llength [glob -nocomplain ${gccdir}/${mldir}/libgcc_s*.${so_extension}.*]] >= 1 } {
221                     lappend libjava_libgcc_s_path "${gccdir}/${mldir}"
222                 }
223             }
224         }
225     }
226
227     set libjava_initialized 1
228 }
229
230 # Find a library.  We know where libtool puts the actual libraries,
231 # and we look there.  The implementation is fairly hacky.  We can't
232 # compile with -nodefaultlibs, because that will also eliminate the
233 # system libraries we need.  In order to have gcj still work, it must
234 # find the appropriate libraries so we must add -L options for their
235 # paths.  However we can't simply use those libraries; we still need
236 # libtool for linking.
237 # Don't return the the lib${name}.la files here, since this causes the
238 # libraries to be linked twice: once as lib${name}.so/dylib and another time
239 # via gcj's implicit -l${name}.  This is both unnecessary and causes the
240 # Solaris ld to warn: attempted multiple inclusion of file.  This warning
241 # is not ignored by the dejagnu framework and cannot be disabled.
242 proc libjava_find_lib {dir name} {
243     global base_dir
244     set gp [get_multilibs]
245     foreach extension {so dll a} {
246         foreach sub {.libs _libs} {
247             if {$gp != ""} {
248                 if {[file exists $gp/$dir/$sub/lib${name}.${extension}]} then {
249                     # Just return the `-L' option.  The library itself
250                     # will be picked up via the spec file.
251                     return "-L$gp/$dir/$sub"
252                 }
253             }
254             # Just return the `-L' option.  The library itself will be
255             # picked up via the spec file.
256             set lib [findfile \
257                        $base_dir/../../$dir/$sub/lib${name}.${extension} \
258                        "-L$base_dir/../../$dir/$sub" \
259                        ""]
260             if {$lib != ""} {
261                 return $lib
262             }
263         }
264     }
265     return ""
266 }
267
268 # Find libgcj.spec.  We need to use the file corresponding to the multilib
269 # under test since they might differ.  Append a trailing slash since this
270 # is used with -B.
271 proc libjava_find_spec {} {
272     global objdir
273     return "$objdir/../"
274 }
275
276 # Find `gij'.  Return empty string if not found.
277 proc libjava_find_gij {} {
278     global base_dir objdir
279
280     set gijdir [lookfor_file [get_multilibs] libjava];
281     if {! [file exists $gijdir/gij]} {
282         return ""
283     }
284     return $gijdir/gij
285 }
286
287 # Remove a bunch of files.
288 proc gcj_cleanup {args} {
289     foreach file $args {
290         if {[string match *.o $file]} {
291             verbose "removing [file rootname $file].lo"
292             file delete -force [file rootname $file].lo
293         }
294         file delete -force -- $file
295         verbose "removing $file"
296     }
297     # It is simplest to do this instead of trying to figure out what
298     # bits in .libs ought to be removed.
299     catch {system "rm -rf .libs"}
300 }
301
302 # Compute arguments needed for compiler.  MODE is a libtool mode:
303 # either compile or link.
304 proc libjava_arguments {{mode compile}} {
305     global base_dir
306     global LIBJAVA
307     global srcdir subdir objdir
308     global TOOL_OPTIONS
309     global GCJ_UNDER_TEST
310     global tmpdir
311     global runtests
312     global env
313     global tool_root_dir
314     global libgcj_jar
315     global libjava_libgcc_s_path
316     global libjava_ld_library_path
317     global ld_library_path
318     global target_triplet
319
320     if [info exists LIBJAVA] {
321         set libjava $LIBJAVA;
322     } else {
323         set libjava [libjava_find_lib libjava gcj]
324     }
325
326     verbose "using LIBJAVA = $libjava" 2
327     set args ""
328
329     # Basically we want to build up a colon separated path list from
330     # the value of $libjava.
331
332     set lpath "."
333     foreach dir [list $libjava] {
334         foreach item [split $dir " "] {
335             switch -glob -- $item {
336                 "-L*" {
337                     lappend lpath [string range $item 2 end]
338                 }
339             }
340         }
341     }
342
343     set lpath [concat $lpath $libjava_libgcc_s_path]
344     verbose "lpath = $lpath ; libgcc_s_path = $libjava_libgcc_s_path"
345     set ld_library_path [join $lpath :]
346     set libjava_ld_library_path "$ld_library_path"
347
348     # That's enough to make things work for the normal case.
349     # If we wanted to handle an arbitrary value of libjava,
350     # then we'd have to do a lot more work.
351
352     set_ld_library_path_env_vars
353     if [info exists env(LD_LIBRARY_PATH)] {
354         verbose "LD_LIBRARY_PATH = $env(LD_LIBRARY_PATH)"
355     }
356
357     # Determine CLASSPATH separator
358     if { [string match "i?86-pc-mingw32*" $target_triplet] } {
359         set sep ";"
360     } else {
361         set sep ":"
362     }
363
364     # Set the CLASSPATH environment variable
365     global env
366     set env(CLASSPATH) \
367         [join [list . $srcdir/$subdir $objdir $libgcj_jar] $sep]
368     verbose "CLASSPATH is $env(CLASSPATH)"
369
370     if {$mode == "link"} {
371         global wrapper_file wrap_compile_flags
372         lappend args "additional_flags=$wrap_compile_flags"
373         lappend args "libs=$wrapper_file"
374         lappend args "libs=$libjava"
375         lappend args debug
376     }
377
378     if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } {
379         lappend args "libs=${gluefile}"
380         lappend args "ldflags=$wrap_flags"
381     }
382
383     if [info exists TOOL_OPTIONS] {
384         lappend args "additional_flags=$TOOL_OPTIONS"
385     }
386
387     # Determine libgcj.spec corresponding to multilib under test.
388     set specdir [libjava_find_spec]
389
390     # Search for libtool.  We need it to link.
391     set found_compiler 0
392     set d [absolute $objdir]
393     foreach x {. .. ../.. ../../..} {
394         if {[file exists $d/$x/libtool]} then {
395             # We have to run silently to avoid DejaGNU lossage.
396             lappend args \
397               "compiler=$d/$x/libtool --silent --tag=GCJ --mode=$mode $GCJ_UNDER_TEST -B$specdir"
398             set found_compiler 1
399             break
400         }
401     }
402     if {! $found_compiler} {
403         # Append -B$specdir so that we find libgcj.spec before it
404         # is installed.
405         lappend args "compiler=$GCJ_UNDER_TEST -B$specdir"
406     }
407
408     # Avoid libtool wrapper scripts when possible.
409     # but not if libtool warnings results in FAILs
410     if {$mode == "link"} {
411         if {! [istarget "*-*-cygwin*"] && ! [istarget "*-*-mingw*"] } {
412             lappend args "additional_flags=-no-install"
413         }
414         if { [istarget "*-*-darwin*"] } {
415             lappend args "additional_flags=-bind_at_load"
416             lappend args "additional_flags=-multiply_defined suppress"
417         }
418     }
419
420     return $args
421 }
422
423 # Link a bunch of objects into a program.  MAIN is the name of the
424 # class holding `main'.  Return 0 on failure.
425 proc gcj_link {program main files {options {}}} {
426     set arguments [libjava_arguments link]
427     if {[llength $options]} {
428         eval lappend arguments $options
429     }
430     lappend arguments "additional_flags=--main=$main"
431     set x [libjava_prune_warnings \
432              [libjava_tcompile $files $program executable $arguments]]
433     if {$x != ""} {
434         verbose "link failure: $x" 2
435         fail "linking $program"
436         setup_xfail "*-*-*"
437         fail "running $program"
438         return 0
439     }
440
441     pass "linking $program"
442     return 1
443 }
444
445 # Invoke the program and see what happens.  Return 0 on failure.
446 proc gcj_invoke {program expectFile ld_library_additions} {
447   global env
448   global libjava_ld_library_path
449   global ld_library_path
450
451   set ld_library_path "$libjava_ld_library_path"
452   if {[llength $ld_library_additions] > 0} {
453     append ld_library_path :[join $ld_library_additions :]
454   }
455
456   set_ld_library_path_env_vars
457   if [info exists env(LD_LIBRARY_PATH)] {
458     verbose "LD_LIBRARY_PATH=$env(LD_LIBRARY_PATH)"
459   }
460
461   set result [libjava_load ./$program]
462   set status [lindex $result 0]
463   set output [lindex $result 1]
464
465   # Restore setting
466   restore_ld_library_path_env_vars
467
468   if {$status != "pass"} {
469     verbose "got $output"
470     fail "$program run"
471     untested "$program output"
472     return 0
473   }
474
475   set id [open $expectFile r]
476   set expected [read $id]
477   close $id
478
479   if {! [string compare $output $expected]} {
480     pass "$program output"
481     return 1
482   } else {
483     fail "$program output"
484     return 0
485   }
486 }
487
488 # Invoke a program and check its output.  EXECUTABLE is the program;
489 # ARGS are the arguments to the program.  Returns 1 if tests passed
490 # (or things were left untested), 0 otherwise.
491 proc libjava_invoke {errname testName optName executable inpfile resultfile
492                       ld_library_additions args} {
493     global env
494     global libjava_ld_library_path
495     global ld_library_path
496
497     set ld_library_path "$libjava_ld_library_path"
498     if {[llength $ld_library_additions] > 0} {
499         append ld_library_path :[join $ld_library_additions :]
500     }
501
502     set_ld_library_path_env_vars
503     if [info exists env(LD_LIBRARY_PATH)] {
504         verbose "LD_LIBRARY_PATH=$env(LD_LIBRARY_PATH)"
505     }
506
507     upvar $optName opts
508
509     if {[info exists opts(no-exec)]} {
510         if {[info exists opts(need-threads)]} {
511             # This means we wanted to try to run it but we couldn't
512             # because threads aren't supported.  So we have to
513             # generate an `untested'.
514             untested "$errname execution - $testName"
515             untested "$errname output - $testName"
516         }
517         return 1
518     }
519
520     set result [libjava_load $executable $args "$inpfile"]
521     set status [lindex $result 0]
522     set output [lindex $result 1]
523
524     # Restore LD_LIBRARY_PATH setting.
525     restore_ld_library_path_env_vars
526
527     if {[info exists opts(xfail-exec)]} then {
528         setup_xfail *-*-*
529     }
530     $status "$errname execution - $testName"
531     if { $status != "pass" } {
532         untested "$errname output - $testName"
533         return 0
534     }
535
536     verbose "resultfile is $resultfile"
537     set id [open $resultfile r]
538     set expected ""
539     append expected [read $id]
540     regsub -all "\r" "$output" "" output
541     regsub "\n*$" $expected "" expected
542     regsub "\n*$" $output "" output
543     regsub "^\n*" $expected "" expected
544     regsub "^\n*" $output "" output
545     regsub -all "\[ \t\]\[ \t\]*" $expected " " expected
546     regsub -all "\[ \t\]*\n\n*" $expected "\n" expected
547     regsub -all "\[ \t\]\[ \t\]*" $output " " output
548     regsub -all "\[ \t\]*\n\n*" $output "\n" output
549     verbose "expected is $expected"
550     verbose "actual is $output"
551     set passed 0
552     if {[info exists opts(regexp_match)]} {
553         if [regexp $expected $output] {
554             set passed 1
555         }
556     } else {
557         if { $expected == $output } {
558             set passed 1
559         }
560     }
561     if {[info exists opts(xfail-output)]} {
562         setup_xfail *-*-*
563     }
564     if { $passed == 1 } {
565         pass "$errname output - $testName"
566     } else {
567         fail "$errname output - $testName"
568     }
569     close $id
570
571     return $passed
572 }
573
574 #
575 # Run the test specified by srcfile and resultfile. compile_args and
576 # exec_args are options telling this proc how to work.
577 #
578 proc test_libjava_from_source { options srcfile compile_args inpfile resultfile exec_args } {
579     global base_dir
580     global srcdir subdir objdir
581     global TOOL_OPTIONS
582     global GCJ_UNDER_TEST
583     global tmpdir
584     global runtests
585
586     # Make opts into an array.
587     set opts(_) x
588     unset opts(_)
589     foreach item $exec_args {
590         set opts($item) x
591     }
592
593     # If we need threads and we don't have them then set the `no-exec'
594     # flag.  This is case is also handled specially later.
595     if {[info exists opts(need-threads)]} {
596         global libjava_uses_threads
597         if {! $libjava_uses_threads} {
598             set opts(no-exec) x
599         }
600     }
601
602     set errname [file rootname [file tail $srcfile]]
603     if {! [runtest_file_p $runtests $errname]} {
604         return
605     }
606
607     if {[info exists opts(no-link)]} {
608         set mode compile
609     } else {
610         set mode link
611     }
612     set args [libjava_arguments $mode]
613     if {! [info exists opts(no-link)]} {
614         # Add the --main flag
615         lappend args "additional_flags=--main=[file rootname [file tail $srcfile]]"
616         if { $compile_args != "" } {
617             lappend args "additional_flags=$compile_args"
618         }
619     }
620
621     regsub "^.*/(\[^/.\]+)\[.\]\[^/]*$" "$srcfile" "\\1" out
622     set executable "${objdir}/$out"
623     if {[info exists opts(no-link)]} {
624         append executable ".o"
625         set target object
626     } else {
627         # DOS/win32 targets default to .exe if no suffix is given
628         # We then try to delete a file that doesn't exist.  It is
629         # simpler to add the suffix everywhere.
630         append executable ".exe"
631         set target executable
632     }
633     if { $compile_args != "" } {
634         set errname "$errname $compile_args"
635     }
636
637     set removeList [list $executable]
638
639     set x [libjava_prune_warnings \
640              [libjava_tcompile $srcfile "$executable" $target $args]]
641     if {[info exists opts(xfail-gcj)]} {
642         setup_xfail *-*-*
643     }
644     if { $x != "" } {
645         verbose "target_compile failed: $x" 2
646
647         if {[info exists opts(shouldfail)]} {
648             pass "$errname compilation from source"
649             eval gcj_cleanup $removeList
650             return
651         }
652
653         fail "$errname compilation from source"
654         if {[info exists opts(xfail-gcj)]
655             || ! [info exists opts(no-exec)]
656             || [info exists opts(need-threads)]} {
657             untested "$errname execution from source compiled test"
658             untested "$errname output from source compiled test"
659         }
660         return
661     }
662     if {[info exists opts(shouldfail)]} {
663         fail "$errname compilation from source"
664         return
665     }
666     pass "$errname compilation from source"
667
668     # Set up the options the way they are expected by libjava_invoke.
669     if {[info exists opts(xfail-source-output)]} {
670         set opts(xfail-output) x
671     }
672     if {[libjava_invoke $errname "source compiled test" opts $executable \
673            $inpfile $resultfile ""]} {
674         # Everything ok, so clean up.
675         eval gcj_cleanup $removeList
676     }
677 }
678
679 #
680 # Run the test specified by srcfile and resultfile. compile_args and
681 # exec_args are options telling this proc how to work.
682 #
683 proc test_libjava_from_javac { options srcfile compile_args inpfile resultfile exec_args } {
684     global base_dir
685     global srcdir subdir objdir
686     global TOOL_OPTIONS
687     global GCJ_UNDER_TEST
688     global tmpdir
689     global runtests
690     global INTERPRETER
691
692     # Make opts into an array.
693     set opts(_) x
694     unset opts(_)
695     foreach item $exec_args {
696         set opts($item) x
697     }
698
699     # If we need threads and we don't have them then set the `no-exec'
700     # flag.  This is case is also handled specially later.
701     if {[info exists opts(need-threads)]} {
702         global libjava_uses_threads
703         if {! $libjava_uses_threads} {
704             set opts(no-exec) x
705         }
706     }
707     set errname [file rootname [file tail $srcfile]]
708     if {! [runtest_file_p $runtests $errname]} {
709         return
710     }
711
712     # bytecompile files with Sun's compiler for now.
713     set bc_ok [bytecompile_file $srcfile $objdir]
714
715     set javac [find_javac]
716     # This is an ugly heuristic but it will have to do.
717     if {[string match *gcj* $javac]} {
718         set tag gcjC
719     } else {
720         set tag javac
721     }
722     if {[info exists opts(xfail-$tag)]} {
723         setup_xfail *-*-*
724     }
725     if {! $bc_ok} then {
726         if {[info exists opts(shouldfail)]} {
727             pass "$errname byte compilation"
728             return
729         }
730         fail "$errname byte compilation"
731         untested "$errname compilation from bytecode"
732         if {! [info exists opts(no-exec)]
733             || [info exists opts(need-threads)]} {
734             untested "$errname execution from bytecode->native test"
735             untested "$errname output from bytecode->native test"
736         }
737         return
738     }
739     if {[info exists opts(shouldfail)]} {
740         fail "$errname byte compilation"
741         return
742     }
743     pass "$errname byte compilation"
744
745     set removeList {}
746
747     # Find name to use for --main, and name of all class files.
748     set jvscan [find_jvscan]
749     verbose "jvscan is $jvscan"
750     set main_name [string trim \
751                      [libjava_prune_warnings \
752                         [lindex [local_exec "$jvscan --encoding=UTF-8 $srcfile --print-main" "" "" 300] 1]]]
753     verbose "main name is $main_name"
754     set class_out [string trim \
755                      [libjava_prune_warnings \
756                         [lindex [local_exec "$jvscan --encoding=UTF-8 $srcfile --list-class" "" "" 300] 1]]]
757     verbose "class list is $class_out"
758
759     if {[string match "*parse error*" $main_name]
760         || [string match "*parse error*" $class_out]} {
761         untested "$errname compilation from bytecode"
762         if {! [info exists opts(no-exec)]
763             || [info exists opts(need-threads)]} {
764             untested "$errname execution from bytecode->native test"
765             untested "$errname output from bytecode->native test"
766         }
767         return
768     }
769
770     # Turn "a b" into "a.class b.class".
771     # Also, turn "foo.bar" into "foo/bar.class".
772     set class_files {}
773     foreach file [split [string trim $class_out]] {
774         set file [join [split $file .] /]
775         lappend class_files $objdir/$file.class
776     }
777
778     eval lappend removeList $class_files
779
780     # Usually it is an error for a test program not to have a `main'
781     # method.  However, for no-exec tests it is ok.  Treat no-link
782     # like no-exec here.
783     if {[info exists opts(no-link)]} {
784         set opts(no-exec) x
785     }
786     set largs {}
787
788     if {[info exists opts(no-exec)]} {
789         set type object
790         set mode compile
791     } elseif {$main_name == ""} {
792         perror "No `main' given in program $errname"
793         return
794     } else {
795         set type executable
796         lappend largs "additional_flags=--main=$main_name"
797         # DOS/win32 targets default to .exe if no suffix is given
798         # We then try to delete a file that doesn't exist.  It is
799         # simpler to add the suffix everywhere.
800         set executable "${objdir}/${main_name}.exe"
801         set mode link
802     }
803
804     # We purposely ignore errors here; we still want to run the other
805     # appropriate tests.
806     set gij [libjava_find_gij]
807     # libjava_find_gij will return "" if it couldn't find the
808     # program; in this case we want to skip the test.
809     if {$INTERPRETER == "yes" && $gij != ""} {
810         libjava_invoke $errname "gij test" opts $gij \
811           $inpfile $resultfile "" $main_name
812     }
813
814     # Initial arguments.
815     set args [libjava_arguments $mode]
816     eval lappend args $largs
817
818     if { $compile_args != "" } {
819         lappend args "additional_flags=$compile_args"
820     }
821
822     if { $compile_args != "" } {
823         set errname "$errname $compile_args"
824     }
825
826     verbose "compilation command = $args" 2
827     # When compiling and not linking, we have to build each .o
828     # separately.  We do this because DejaGNU's target_compile won't
829     # accept an empty "destfile" argument when the mode is "compile".
830     if {$mode == "compile"} {
831         foreach c_file $class_files {
832             set executable [file rootname [file tail $c_file]].o
833             # Don't write files which contain $ chars.
834             regsub -all "\\$" $executable "\^" executable
835             set x [libjava_prune_warnings \
836                      [libjava_tcompile '$c_file' "$executable" $type $args]]
837             lappend removeList $executable
838             if {$x != ""} {
839                 break
840             }
841         }
842     } else {
843         # This is so evil: we de-listify CLASS_FILES so that we can
844         # turn around and quote the `$' in it for the shell.  I really
845         # hate DejaGNU.  It is so !@#$!@# unpredictable.
846         set hack ""
847         foreach stupid $class_files {
848             set hack "$hack $stupid"
849         }
850         lappend removeList $executable
851         set x [libjava_prune_warnings \
852                  [libjava_tcompile $hack "$executable" $type $args]]
853     }
854     if {[info exists opts(xfail-byte)]} {
855         setup_xfail *-*-*
856     }
857     if { $x != "" } {
858         verbose "target_compile failed: $x" 2
859         fail "$errname compilation from bytecode"
860         if {! [info exists opts(no-exec)]
861             || [info exists opts(need-threads)]} {
862             untested "$errname execution from bytecode->native test"
863             untested "$errname output from bytecode->native test"
864         }
865         return;
866     }
867     pass "$errname compilation from bytecode"
868
869     # Set up the options the way they are expected by libjava_invoke.
870     if {[info exists opts(xfail-byte-output)]} {
871         set opts(xfail-output) x
872     }
873     if {[libjava_invoke $errname "bytecode->native test" opts $executable \
874            $inpfile $resultfile ""]} {
875         # Everything ok, so clean up.
876         eval gcj_cleanup $removeList
877     }
878 }
879
880 #
881 # Run the test specified by srcfile and resultfile. compile_args and
882 # exec_args are options telling this proc how to work.
883 #   `no-link'     don't try to link the program
884 #   `no-exec'     don't try to run the test
885 #   `xfail-gcj'   compilation from source will fail
886 #   `xfail-javac' compilation with javac will fail
887 #   `xfail-gcjC'  compilation with gcj -C will fail
888 #   `shouldfail'  compilation from source is supposed to fail
889 #                 This is different from xfail, which marks a known
890 #                 failure that we just haven't fixed.
891 #                 A compilation marked this way should fail with any
892 #                 front end.
893 #   `xfail-byte'  compilation from bytecode will fail
894 #   `xfail-exec'  exec will fail
895 #   `xfail-output'
896 #                 output will be wrong
897 #   `xfail-byte-output'
898 #                 output will be wrong when compiled from bytecode
899 #   `xfail-source-output'
900 #                 output will be wrong when compiled from source code
901 #   `need-threads'
902 #                 test relies on thread support
903 #
904 proc test_libjava { options srcfile compile_args inpfile resultfile exec_args } {
905     test_libjava_from_source $options $srcfile $compile_args $inpfile $resultfile $exec_args
906     test_libjava_from_javac $options $srcfile $compile_args $inpfile $resultfile $exec_args
907  }
908
909 #
910 # libjava_version -- extract and print the version number of libjavap
911 #
912 proc default_libjava_version {} {
913 }
914
915 proc default_libjava_start { } {
916 }
917
918 # Local Variables:
919 # tcl-indent-level:4
920 # End: