libjava.exp

this gcc-g++-3.3.1.tar.gz is a source file of gcc, you can learn more about gcc through this codes f

	     [libjava_tcompile $files $program executable $arguments]]
    if {$x != ""} {
	verbose "link failure: $x" 2
	fail "linking $program"
	setup_xfail "*-*-*"
	fail "running $program"
	return 0
    }

    pass "linking $program"
    return 1
}

# Invoke a program and check its output.  EXECUTABLE is the program;
# ARGS are the arguments to the program.  Returns 1 if tests passed
# (or things were left untested), 0 otherwise.
proc libjava_invoke {errname testName optName executable inpfile resultfile args} {
    upvar $optName opts

    if {[info exists opts(no-exec)]} {
	if {[info exists opts(need-threads)]} {
	    # This means we wanted to try to run it but we couldn't
	    # because threads aren't supported.  So we have to
	    # generate an `untested'.
	    untested "$errname execution - $testName"
	    untested "$errname output - $testName"
	}
	return 1
    }

    set result [libjava_load $executable $args "$inpfile"]
    set status [lindex $result 0]
    set output [lindex $result 1]
    if {[info exists opts(xfail-exec)]} then {
	setup_xfail *-*-*
    }
    $status "$errname execution - $testName"
    if { $status != "pass" } {
	untested "$errname output - $testName"
	return 0
    }

    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(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 - $testName"
    } else {
	fail "$errname output - $testName"
    }
    close $id

    return $passed
}

#
# 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
    }

    # If we need threads and we don't have them then set the `no-exec'
    # flag.  This is case is also handled specially later.
    if {[info exists opts(need-threads)]} {
	global libjava_uses_threads
	if {! $libjava_uses_threads} {
	    set opts(no-exec) 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 {
        # DOS/win32 targets default to .exe if no suffix is given
        # We then try to delete a file that doesn't exist.  It is
        # simpler to add the suffix everywhere.
        append executable ".exe"
	set target executable
    }
    if { $compile_args != "" } {
	set errname "$errname $compile_args"
    }

    set removeList [list $executable]

    set x [libjava_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"
	    eval gcj_cleanup $removeList
	    return
	}

	fail "$errname compilation from source"
	if {[info exists opts(xfail-gcj)]
	    || ! [info exists opts(no-exec)]
	    || [info exists opts(need-threads)]} {
	    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"

    # Set up the options the way they are expected by libjava_invoke.
    if {[info exists opts(xfail-source-output)]} {
	set opts(xfail-output) x
    }
    if {[libjava_invoke $errname "source compiled test" opts $executable \
	   $inpfile $resultfile]} {
	# Everything ok, so clean up.
	eval gcj_cleanup $removeList
    }
}

#
# 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
    global INTERPRETER

    # Make opts into an array.
    set opts(_) x
    unset opts(_)
    foreach item $exec_args {
	set opts($item) x
    }

    # If we need threads and we don't have them then set the `no-exec'
    # flag.  This is case is also handled specially later.
    if {[info exists opts(need-threads)]} {
	global libjava_uses_threads
	if {! $libjava_uses_threads} {
	    set opts(no-exec) 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)]
	    || [info exists opts(need-threads)]} {
	    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"

    set removeList {}

    # 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 \
		     [libjava_prune_warnings \
			[lindex [local_exec "$jvscan --encoding=UTF-8 $srcfile --print-main" "" "" 300] 1]]]
    verbose "main name is $main_name"
    set class_out [string trim \
		     [libjava_prune_warnings \
			[lindex [local_exec "$jvscan --encoding=UTF-8 $srcfile --list-class" "" "" 300] 1]]]
    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)]
	    || [info exists opts(need-threads)]} {
	    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
    }

    eval lappend removeList $class_files

    # 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"
	# DOS/win32 targets default to .exe if no suffix is given
        # We then try to delete a file that doesn't exist.  It is
	# simpler to add the suffix everywhere.
	set executable "${objdir}/${main_name}.exe"
	set mode link
    }

    # We purposely ignore errors here; we still want to run the other
    # appropriate tests.
    set gij [libjava_find_gij]
    # libjava_find_gij will return `gij' if it couldn't find the
    # program; in this case we want to skip the test.
    if {$INTERPRETER == "yes" && $gij != "gij"} {
	libjava_invoke $errname "gij test" opts $gij \
	  $inpfile $resultfile $main_name
    }

    # 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
	    # Don't write files which contain $ chars.
	    regsub -all "\\$" $executable "\^" executable
	    set x [libjava_prune_warnings \
		     [libjava_tcompile '$c_file' "$executable" $type $args]]
	    lappend removeList $executable
	    if {$x != ""} {
		break
	    }
	}
    } else {
	# This is so 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"
	}
	lappend removeList $executable
	set x [libjava_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)]
	    || [info exists opts(need-threads)]} {
	    untested "$errname execution from bytecode->native test"
	    untested "$errname output from bytecode->native test"
	}
	return;
    }
    pass "$errname compilation from bytecode"

    # Set up the options the way they are expected by libjava_invoke.
    if {[info exists opts(xfail-byte-output)]} {
	set opts(xfail-output) x
    }
    if {[libjava_invoke $errname "bytecode->native test" opts $executable \
	   $inpfile $resultfile]} {
	# Everything ok, so clean up.
	eval gcj_cleanup $removeList
    }
}

#
# 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 haven'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
#   `xfail-byte-output'
#                 output will be wrong when compiled from bytecode
#   `xfail-source-output'
#                 output will be wrong when compiled from source code
#   `need-threads'
#                 test relies on thread support
#
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 { } {
}

# On IRIX 6, we have to set variables akin to LD_LIBRARY_PATH, but
# called LD_LIBRARYN32_PATH (for the N32 ABI) and LD_LIBRARY64_PATH
# (for the 64-bit ABI).  The right way to do this would be to modify
# unix.exp -- but that's not an option since it's part of DejaGNU
# proper, so we do it here, by trickery.  We really only need to do 
# this on IRIX, but it shouldn't hurt to do it anywhere else.

proc ${tool}_set_ld_library_path { name element op } {
  setenv LD_LIBRARYN32_PATH [getenv LD_LIBRARY_PATH]
  setenv LD_LIBRARY64_PATH [getenv LD_LIBRARY_PATH]
}

trace variable env(LD_LIBRARY_PATH) w ${tool}_set_ld_library_path

# Local Variables:
# tcl-indent-level:4
# End: