| # Copyright (C) 1998, 1999, 2000, 2001 Free Software Foundation |
| |
| load_lib "libgloss.exp" |
| |
| # GCJ_UNDER_TEST is the compiler under test. |
| |
| global tmpdir |
| |
| if ![info exists tmpdir] { |
| set tmpdir "/tmp" |
| } |
| |
| # This is like `target_compile' but it does some surgery to work |
| # around stupid DejaGNU bugs. In particular DejaGNU has very poor |
| # quoting, so for instance a `$' will be re-evaluated at spawn time. |
| # We don't want that. |
| proc libjava_tcompile {source destfile type options} { |
| # This strange-looking expression really does quote the `$'. |
| regsub -all -- {\$} $source {\$} source |
| regsub -all -- {\$} $destfile {\$} destfile |
| return [target_compile $source $destfile $type $options] |
| } |
| |
| # Read an `xfail' file if it exists. Returns a list of xfail tokens. |
| proc libjava_read_xfail {file} { |
| if {! [file exists $file]} { |
| return "" |
| } |
| set fd [open $file r] |
| set tokens [string trim [read $fd]] |
| close $fd |
| return $tokens |
| } |
| |
| # Find a particular executable. FIXME: this relies on DejaGnu |
| # internals. These should probably be exposed in a better way. |
| proc libjava_find_program {prog} { |
| global tool_root_dir |
| |
| set file [lookfor_file $tool_root_dir $prog] |
| if { $file == "" } { |
| set file [lookfor_file $tool_root_dir gcc/$prog]; |
| } |
| if {$file == ""} { |
| set file $prog |
| } |
| return $file |
| } |
| |
| # Find `jv-scan'. |
| proc find_jvscan {} { |
| return [libjava_find_program jv-scan] |
| } |
| |
| # Find `gcjh'. |
| proc find_gcjh {} { |
| return [libjava_find_program gcjh] |
| } |
| |
| proc find_javac {} { |
| global SUN_JAVAC GCJ_UNDER_TEST env |
| # If JDK doesn't run on your platform but some other |
| # JDK-compatible javac does, you may set SUN_JAVAC to point to it. |
| # One of the most important properties of a SUN_JAVAC is that it |
| # must create class-files even for classes that have not been |
| # specified in the command line, but that were needed to compile |
| # those that have. For example, Pizza won't do it, but you can |
| # use `kaffe sun.tools.javac.Main', if you have Sun's classes.zip |
| # in the kaffe's default search path. |
| if {![info exists SUN_JAVAC]} { |
| if {[info exists env(SUN_JAVAC)]} { |
| set SUN_JAVAC $env(SUN_JAVAC) |
| } else { |
| set SUN_JAVAC "$GCJ_UNDER_TEST -C" |
| } |
| } |
| return $SUN_JAVAC |
| } |
| |
| proc bytecompile_file { file objdir {classpath {}} } { |
| global env |
| set dirname [file dirname $file] |
| |
| set javac [find_javac] |
| if {$classpath != ""} then { |
| set env(CLASSPATH) $classpath |
| } |
| set here [pwd] |
| cd $dirname |
| if {[catch { |
| set q [eval exec "$javac [list $file] -d $objdir 2>@ stdout"] |
| } msg]} then { |
| verbose "couldn't compile $file: $msg" |
| set r 0 |
| } else { |
| set r 1 |
| } |
| cd $here |
| return $r |
| } |
| |
| set libjava_initialized 0 |
| |
| # |
| # Build the status wrapper library as needed. |
| # |
| proc libjava_init { args } { |
| global wrapper_file; |
| global wrap_compile_flags; |
| global libjava_initialized |
| global GCJ_UNDER_TEST |
| global TOOL_EXECUTABLE |
| global original_ld_library_path |
| global env |
| |
| if { $libjava_initialized == 1 } { return; } |
| |
| 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]" |
| } |
| } |
| } |
| |
| if [info exists env(LD_LIBRARY_PATH)] { |
| set original_ld_library_path $env(LD_LIBRARY_PATH) |
| } else { |
| if [info exists env(SHLIB_PATH)] { |
| set original_ld_library_path $env(SHLIB_PATH) |
| } else { |
| set original_ld_library_path "" |
| } |
| } |
| |
| set wrapper_file ""; |
| set wrap_compile_flags ""; |
| if [target_info exists needs_status_wrapper] { |
| set result [build_wrapper "testglue.o"]; |
| if { $result != "" } { |
| set wrapper_file [lindex $result 0]; |
| set wrap_compile_flags [lindex $result 1]; |
| } else { |
| warning "Status wrapper failed to build." |
| } |
| } |
| |
| set libjava_initialized 1 |
| } |
| |
| # Find a library. We know where libtool puts the actual libraries, |
| # and we look there. The implementation is fairly hacky. We can't |
| # compile with -nodefaultlibs, because that will also eliminate the |
| # system libraries we need. In order to have gcj still work, it must |
| # find the appropriate libraries so we must add -L options for their |
| # paths. However we can't simply use those libraries; we still need |
| # libtool for linking. |
| proc libjava_find_lib {dir name} { |
| global base_dir |
| set gp [get_multilibs] |
| foreach sub {.libs _libs} { |
| if {$gp != ""} { |
| if {[file exists $gp/$dir/$sub/lib${name}.a]} then { |
| return "$gp/$dir/lib${name}.la -L$gp/$dir/$sub" |
| } |
| } |
| set lib [findfile $base_dir/../../$dir/$sub/lib${name}.a \ |
| "$base_dir/../../$dir/lib${name}.la -L$base_dir/../../$dir/$sub" \ |
| ""] |
| if {$lib != ""} { |
| return $lib |
| } |
| } |
| return "" |
| } |
| |
| # Compute arguments needed for compiler. MODE is a libtool mode: |
| # either compile or link. |
| proc libjava_arguments {{mode compile}} { |
| global base_dir |
| global LIBJAVA |
| global LIBGC |
| global LIBQTHREADS |
| global LIBZ |
| global srcdir subdir objdir |
| global TOOL_OPTIONS |
| global GCJ_UNDER_TEST |
| global tmpdir |
| global runtests |
| global env |
| global tool_root_dir |
| |
| if [info exists LIBJAVA] { |
| set libjava $LIBJAVA; |
| } else { |
| set libjava [libjava_find_lib libjava gcj] |
| } |
| |
| if [info exists LIBGC] { |
| set libgc $LIBGC; |
| } else { |
| set libgc [libjava_find_lib boehm-gc gcjgc] |
| } |
| |
| if [info exists LIBQTHREADS] { |
| set libqthreads $LIBQTHREADS |
| } else { |
| set libqthreads [libjava_find_lib qthreads gcjcoop] |
| } |
| |
| if [info exists LIBZ] { |
| set libz $LIBZ |
| } else { |
| set libz [libjava_find_lib zlib zgcj] |
| } |
| |
| # FIXME: there's no way to determine whether -lpthread is |
| # required. We should get this info from configure, or it should |
| # just be in the compiler driver. |
| |
| verbose "using LIBJAVA = $libjava" 2 |
| verbose "using LIBGC = $libgc" 2 |
| verbose "using LIBQTHREADS = $libqthreads" 2 |
| verbose "using LIBZ = $libz" 2 |
| set args "" |
| |
| # Basically we want to build up a colon separated path list from |
| # the value of $libjava. |
| |
| set lpath {} |
| foreach dir [list $libjava $libgc $libz] { |
| foreach item [split $dir " "] { |
| switch -glob -- $item { |
| "-L*" { |
| lappend lpath [string range $item 2 end] |
| } |
| } |
| } |
| } |
| |
| # Finally, add the gcc build directory so that we can find the |
| # shared libgcc. This, like much of dejagnu, is hideous. |
| set gccdir [lookfor_file $tool_root_dir gcc/libgcc_s.so] |
| if {$gccdir != ""} { |
| lappend lpath [file dirname $gccdir] |
| } |
| |
| set ld_library_path [join $lpath :] |
| |
| # That's enough to make things work for the normal case. |
| # If we wanted to handle an arbitrary value of libjava, |
| # then we'd have to do a lot more work. |
| |
| # Set variables the dynamic linker looks at. |
| global original_ld_library_path |
| setenv LD_LIBRARY_PATH "$ld_library_path:$original_ld_library_path" |
| setenv SHLIB_PATH "$ld_library_path:$original_ld_library_path" |
| |
| verbose "LD_LIBRARY_PATH = $env(LD_LIBRARY_PATH)" |
| |
| # Set the CLASSPATH environment variable |
| verbose "CLASSPATH is .:$srcdir/$subdir:$objdir:$objdir/../libgcj.jar" |
| global env |
| set env(CLASSPATH) ".:$srcdir/$subdir:$objdir:$objdir/../libgcj.jar" |
| |
| global wrapper_file wrap_compile_flags; |
| lappend args "additional_flags=$wrap_compile_flags"; |
| lappend args "libs=$wrapper_file"; |
| lappend args "libs=$libjava"; |
| lappend args "libs=$libgc"; |
| lappend args "libs=$libqthreads" |
| lappend args "libs=$libz" |
| lappend args debug |
| |
| if { [target_info needs_status_wrapper]!="" && [info exists gluefile] } { |
| lappend args "libs=${gluefile}" |
| lappend args "ldflags=$wrap_flags" |
| } |
| |
| if [info exists TOOL_OPTIONS] { |
| lappend args "additional_flags=$TOOL_OPTIONS" |
| } |
| |
| # Search for libtool. We need it to link. |
| set found_compiler 0 |
| set d [absolute $objdir] |
| foreach x {. .. ../.. ../../..} { |
| if {[file exists $d/$x/libtool]} then { |
| # We have to run silently to avoid DejaGNU lossage. |
| lappend args \ |
| "compiler=$d/$x/libtool --silent --tag=GCJ --mode=$mode $GCJ_UNDER_TEST -B$objdir/../" |
| set found_compiler 1 |
| break |
| } |
| } |
| if {! $found_compiler} { |
| # Append -B$objdir/../ so that we find libgcj.spec before it |
| # is installed. |
| lappend args "compiler=$GCJ_UNDER_TEST -B$objdir/../" |
| } |
| |
| return $args |
| } |
| |
| |
| # |
| # Run the test specified by srcfile and resultfile. compile_args and |
| # exec_args are options telling this proc how to work. |
| # |
| proc test_libjava_from_source { options srcfile compile_args inpfile resultfile exec_args } { |
| global base_dir |
| global LIBJAVA |
| global LIBGC |
| global srcdir subdir objdir |
| global TOOL_OPTIONS |
| global GCJ_UNDER_TEST |
| global tmpdir |
| global runtests |
| |
| # Make opts into an array. |
| set opts(_) x |
| unset opts(_) |
| foreach item $exec_args { |
| set opts($item) x |
| } |
| |
| set errname [file rootname [file tail $srcfile]] |
| if {! [runtest_file_p $runtests $errname]} { |
| return |
| } |
| |
| if {[info exists opts(no-link)]} { |
| set mode compile |
| } else { |
| set mode link |
| } |
| set args [libjava_arguments $mode] |
| if {! [info exists opts(no-link)]} { |
| # Add the --main flag |
| lappend args "additional_flags=--main=[file rootname [file tail $srcfile]]" |
| if { $compile_args != "" } { |
| lappend args "additional_flags=$compile_args" |
| } |
| } |
| |
| regsub "^.*/(\[^/.\]+)\[.\]\[^/]*$" "$srcfile" "\\1" out |
| set executable "${objdir}/$out" |
| if {[info exists opts(no-link)]} { |
| append executable ".o" |
| set target object |
| } else { |
| set target executable |
| } |
| if { $compile_args != "" } { |
| set errname "$errname $compile_args" |
| } |
| |
| set x [prune_warnings \ |
| [libjava_tcompile $srcfile "$executable" $target $args]] |
| if {[info exists opts(xfail-gcj)]} { |
| setup_xfail *-*-* |
| } |
| if { $x != "" } { |
| verbose "target_compile failed: $x" 2 |
| |
| if {[info exists opts(shouldfail)]} { |
| pass "$errname compilation from source" |
| return |
| } |
| |
| fail "$errname compilation from source" |
| if {[info exists opts(xfail-gcj)] || ! [info exists opts(no-exec)]} { |
| untested "$errname execution from source compiled test" |
| untested "$errname output from source compiled test" |
| } |
| return |
| } |
| if {[info exists opts(shouldfail)]} { |
| fail "$errname compilation from source" |
| return |
| } |
| pass "$errname compilation from source" |
| |
| if {[info exists opts(no-exec)] |
| || [info exists opts(no-link)]} { |
| return |
| } |
| |
| set result [libjava_load $executable "" "$inpfile"]; |
| set status [lindex $result 0]; |
| set output [lindex $result 1]; |
| if {[info exists opts(xfail-exec)]} then { |
| setup_xfail *-*-* |
| } |
| $status "$errname execution from source compiled test" |
| if { $status != "pass" } { |
| untested "$errname output from source compiled test" |
| return; |
| } |
| |
| verbose "resultfile is $resultfile" |
| set id [open $resultfile r]; |
| set expected "" |
| append expected [read $id]; |
| regsub -all "\r" "$output" "" output; |
| regsub "\n*$" $expected "" expected |
| regsub "\n*$" $output "" output |
| regsub "^\n*" $expected "" expected |
| regsub "^\n*" $output "" output |
| regsub -all "\[ \t\]\[ \t\]*" $expected " " expected |
| regsub -all "\[ \t\]*\n\n*" $expected "\n" expected |
| regsub -all "\[ \t\]\[ \t\]*" $output " " output |
| regsub -all "\[ \t\]*\n\n*" $output "\n" output |
| verbose "expected is $expected" |
| verbose "actual is $output" |
| set passed 0; |
| if {$options == "regexp_match"} { |
| if [regexp $expected $output] { |
| set passed 1; |
| } |
| } else { |
| if { $expected == $output } { |
| set passed 1; |
| } |
| } |
| if {[info exists opts(xfail-output)]} { |
| setup_xfail *-*-* |
| } |
| if { $passed == 1 } { |
| pass "$errname output from source compiled test" |
| } else { |
| clone_output "expected was $expected" |
| clone_output "output was $output" |
| fail "$errname output from source compiled test" |
| } |
| close $id; |
| } |
| |
| # |
| # Run the test specified by srcfile and resultfile. compile_args and |
| # exec_args are options telling this proc how to work. |
| # |
| proc test_libjava_from_javac { options srcfile compile_args inpfile resultfile exec_args } { |
| global base_dir |
| global LIBJAVA |
| global LIBGC |
| global srcdir subdir objdir |
| global TOOL_OPTIONS |
| global GCJ_UNDER_TEST |
| global tmpdir |
| global runtests |
| |
| # Make opts into an array. |
| set opts(_) x |
| unset opts(_) |
| foreach item $exec_args { |
| set opts($item) x |
| } |
| |
| set errname [file rootname [file tail $srcfile]] |
| if {! [runtest_file_p $runtests $errname]} { |
| return |
| } |
| |
| # bytecompile files with Sun's compiler for now. |
| set bc_ok [bytecompile_file $srcfile $objdir] |
| |
| set javac [find_javac] |
| # This is an ugly heuristic but it will have to do. |
| if {[string match *gcj* $javac]} { |
| set tag gcjC |
| } else { |
| set tag javac |
| } |
| if {[info exists opts(xfail-$tag)]} { |
| setup_xfail *-*-* |
| } |
| if {! $bc_ok} then { |
| if {[info exists opts(shouldfail)]} { |
| pass "$errname byte compilation" |
| return |
| } |
| fail "$errname byte compilation" |
| untested "$errname compilation from bytecode" |
| if {! [info exists opts(no-exec)]} { |
| untested "$errname execution from bytecode->native test" |
| untested "$errname output from bytecode->native test" |
| } |
| return |
| } |
| if {[info exists opts(shouldfail)]} { |
| fail "$errname byte compilation" |
| return |
| } |
| pass "$errname byte compilation" |
| |
| # Find name to use for --main, and name of all class files. |
| set jvscan [find_jvscan] |
| verbose "jvscan is $jvscan" |
| set main_name [string trim \ |
| [prune_warnings \ |
| [libjava_tcompile $srcfile "" none \ |
| "compiler=$jvscan additional_flags=--print-main"]]] |
| verbose "main name is $main_name" |
| set class_out [string trim \ |
| [prune_warnings \ |
| [libjava_tcompile $srcfile "" none \ |
| "compiler=$jvscan additional_flags=--list-class"]]] |
| verbose "class list is $class_out" |
| |
| if {[string match "*parse error*" $main_name] |
| || [string match "*parse error*" $class_out]} { |
| untested "$errname compilation from bytecode" |
| if {! [info exists opts(no-exec)]} { |
| untested "$errname execution from bytecode->native test" |
| untested "$errname output from bytecode->native test" |
| } |
| return |
| } |
| |
| # Turn "a b" into "a.class b.class". |
| # Also, turn "foo.bar" into "foo/bar.class". |
| set class_files {} |
| foreach file [split [string trim $class_out]] { |
| set file [join [split $file .] /] |
| lappend class_files $objdir/$file.class |
| } |
| |
| # Usually it is an error for a test program not to have a `main' |
| # method. However, for no-exec tests it is ok. Treat no-link |
| # like no-exec here. |
| if {[info exists opts(no-link)]} { |
| set opts(no-exec) x |
| } |
| set largs {} |
| |
| if {[info exists opts(no-exec)]} { |
| set type object |
| set mode compile |
| } elseif {$main_name == ""} { |
| perror "No `main' given in program $errname" |
| return |
| } else { |
| set type executable |
| lappend largs "additional_flags=--main=$main_name" |
| set executable "${objdir}/$main_name" |
| set mode link |
| } |
| |
| # Initial arguments. |
| set args [libjava_arguments $mode] |
| eval lappend args $largs |
| |
| if { $compile_args != "" } { |
| lappend args "additional_flags=$compile_args" |
| } |
| |
| if { $compile_args != "" } { |
| set errname "$errname $compile_args" |
| } |
| |
| verbose "compilation command = $args" 2 |
| # When compiling and not linking, we have to build each .o |
| # separately. We do this because DejaGNU's target_compile won't |
| # accept an empty "destfile" argument when the mode is "compile". |
| if {$mode == "compile"} { |
| foreach c_file $class_files { |
| set executable [file rootname [file tail $c_file]].o |
| set x [prune_warnings \ |
| [libjava_tcompile $c_file "$executable" $type $args]] |
| if {$x != ""} { |
| break |
| } |
| } |
| } else { |
| # This is no evil: we de-listify CLASS_FILES so that we can |
| # turn around and quote the `$' in it for the shell. I really |
| # hate DejaGNU. It is so !@#$!@# unpredictable. |
| set hack "" |
| foreach stupid $class_files { |
| set hack "$hack $stupid" |
| } |
| set x [prune_warnings \ |
| [libjava_tcompile $hack "$executable" $type $args]] |
| } |
| if {[info exists opts(xfail-byte)]} { |
| setup_xfail *-*-* |
| } |
| if { $x != "" } { |
| verbose "target_compile failed: $x" 2 |
| fail "$errname compilation from bytecode" |
| if {! [info exists opts(no-exec)]} { |
| untested "$errname execution from bytecode->native test" |
| untested "$errname output from bytecode->native test" |
| } |
| return; |
| } |
| pass "$errname compilation from bytecode" |
| |
| if {[info exists opts(no-exec)]} { |
| return |
| } |
| |
| set result [libjava_load $executable "" "$inpfile"]; |
| set status [lindex $result 0]; |
| set output [lindex $result 1]; |
| if {[info exists opts(xfail-exec)]} { |
| setup_xfail *-*-* |
| } |
| $status "$errname execution from bytecode->native test" |
| if { $status != "pass" } { |
| untested "$errname output from bytecode->native test" |
| return; |
| } |
| |
| verbose "resultfile is $resultfile" |
| set id [open $resultfile r]; |
| set expected "" |
| append expected [read $id]; |
| regsub -all "\r" "$output" "" output; |
| regsub "\n*$" $expected "" expected |
| regsub "\n*$" $output "" output |
| regsub "^\n*" $expected "" expected |
| regsub "^\n*" $output "" output |
| regsub -all "\[ \t\]\[ \t\]*" $expected " " expected |
| regsub -all "\[ \t\]*\n\n*" $expected "\n" expected |
| regsub -all "\[ \t\]\[ \t\]*" $output " " output |
| regsub -all "\[ \t\]*\n\n*" $output "\n" output |
| verbose "expected is $expected" |
| verbose "actual is $output" |
| set passed 0; |
| if {[info exists opts(xfail-output)]} { |
| setup_xfail *-*-* |
| } |
| if {$options == "regexp_match"} { |
| if [regexp $expected $output] { |
| set passed 1; |
| } |
| } else { |
| if { $expected == $output } { |
| set passed 1; |
| } |
| } |
| if { $passed == 1 } { |
| pass "$errname output from bytecode->native test" |
| } else { |
| clone_output "expected was $expected" |
| clone_output "output was $output" |
| fail "$errname output from bytecode->native test" |
| } |
| close $id; |
| } |
| |
| # |
| # Run the test specified by srcfile and resultfile. compile_args and |
| # exec_args are options telling this proc how to work. |
| # `no-link' don't try to link the program |
| # `no-exec' don't try to run the test |
| # `xfail-gcj' compilation from source will fail |
| # `xfail-javac' compilation with javac will fail |
| # `xfail-gcjC' compilation with gcj -C will fail |
| # `shouldfail' compilation from source is supposed to fail |
| # This is different from xfail, which marks a known |
| # failure that we just havne't fixed. |
| # A compilation marked this way should fail with any |
| # front end. |
| # `xfail-byte' compilation from bytecode will fail |
| # `xfail-exec' exec will fail |
| # `xfail-output' output will be wrong |
| # |
| proc test_libjava { options srcfile compile_args inpfile resultfile exec_args } { |
| test_libjava_from_source $options $srcfile $compile_args $inpfile $resultfile $exec_args |
| test_libjava_from_javac $options $srcfile $compile_args $inpfile $resultfile $exec_args |
| } |
| |
| # |
| # libjava_version -- extract and print the version number of libjavap |
| # |
| proc default_libjava_version {} { |
| } |
| |
| proc default_libjava_start { } { |
| } |
| |
| # Local Variables: |
| # tcl-indent-level:4 |
| # End: |