Tcl Source Code

			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestsetmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestexitmainloopCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
static int		TestpanicCmd(ClientData dummy,
			    Tcl_Interp *interp, int argc, const char **argv);
#ifndef _WIN32
static int		TestfinexitObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
#endif /* _WIN32 */
static int		TestparseargsCmd(ClientData dummy, Tcl_Interp *interp,
			    int objc, Tcl_Obj *const objv[]);
static int		TestparserObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarObjCmd(ClientData dummy,
			    Tcl_Interp *interp, int objc,
			    Tcl_Obj *const objv[]);
static int		TestparsevarnameObjCmd(ClientData dummy,

	    TestgetvarfullnameCmd, NULL, NULL);
    Tcl_CreateCommand(interp, "testinterpdelete", TestinterpdeleteCmd,
	    NULL, NULL);
    Tcl_CreateCommand(interp, "testlink", TestlinkCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "testlocale", TestlocaleCmd, NULL,
	    NULL);
    Tcl_CreateCommand(interp, "testpanic", TestpanicCmd, NULL, NULL);
#ifndef _WIN32
    Tcl_CreateObjCommand(interp, "testfinexit", TestfinexitObjCmd, NULL, NULL);
#endif /* _WIN32 */
    Tcl_CreateObjCommand(interp, "testparseargs", TestparseargsCmd,NULL,NULL);
    Tcl_CreateObjCommand(interp, "testparser", TestparserObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevar", TestparsevarObjCmd,
	    NULL, NULL);
    Tcl_CreateObjCommand(interp, "testparsevarname", TestparsevarnameObjCmd,
	    NULL, NULL);

/*
 *----------------------------------------------------------------------
 *
 * TestfinexitObjCmd --
 *
 *	Calls a variant of [exit] including the full finalization path.
 *
 *  On Win32, the test suite is run with all Tcltest funcions in a dll,
 *	but TclpExit cannot be called from inside a dynamically loaded dll.
 *	It would mean that the dll is terminated, while there is still a
 *	function on the stack which belong to the dll.
 *
 * Results:
 *	Error, or doesn't return.
 *
 * Side effects:
 *	Exits application.
 *
 *----------------------------------------------------------------------
 */

#ifndef _WIN32
static int
TestfinexitObjCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int objc,			/* Number of arguments. */
    Tcl_Obj *const objv[])	/* Argument objects. */
{

	return TCL_ERROR;
    }
    Tcl_Finalize();
    TclpExit(value);
    /*NOTREACHED*/
    return TCL_ERROR;		/* Better not ever reach this! */
}
#endif /* _WIN32 */


static int
TestfileCmd(
    ClientData dummy,		/* Not used. */
    Tcl_Interp *interp,		/* Current interpreter. */
    int argc,			/* Number of arguments. */
    Tcl_Obj *const argv[])	/* The argument objects. */

package require tcltest 2

namespace eval ::tcl::test::encoding {
    variable x

namespace import -force ::tcltest::*

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::tcltestlib [lindex [package ifneeded Tcltest [info patchlevel]] 1]
}

proc toutf {args} {
    variable x
    lappend x "toutf $args"
}
proc fromutf {args} {
    variable x

    return $data
} [string range $iso2022uniData 0 49] ; # 0 .. 49 inclusive == 50
cd [workingDirectory]

# Code to make the next few tests more intelligible; the code being tested
# should be in the body of the test!
proc runInSubprocess {contents {filename iso2022.tcl}} {
    set contents "load $::tcltestlib Tcltest\n$contents"
    set theFile [makeFile $contents $filename]
    try {
	exec [interpreter] $theFile
    } finally {
	removeFile $theFile
    }
}

    catch {
	file delete -force link.file
	file delete -force dir.link
	file delete -force [file join dir.dir linkinside.file]
    }

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    set ::ddelib [lindex [package ifneeded dde 1.4.0b1] 1]
    set ::reglib [lindex [package ifneeded registry 1.3.0] 1]
}

# Test for commands defined in Tcltest executable
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]

cd [tcltest::temporaryDirectory]

}

test filesystem-7.1.1 {load from vfs} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem} -body {
    # This may cause a crash on exit
    cd [file dirname [info nameof]]

    testsimplefilesystem 1
    # This loads dde via a complex copy-to-temp operation
    load simplefs:/$::ddelib dde
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.1.2 {load from vfs, and then unload again} -setup {
    set dir [pwd]
} -constraints {win testsimplefilesystem} -body {
    # This may cause a crash on exit
    cd [file dirname [info nameof]]

    testsimplefilesystem 1
    # This loads reg via a complex copy-to-temp operation
    load simplefs:/$::reglib Registry
    unload simplefs:/$::reglib
    testsimplefilesystem 0
    return ok
    # The real result of this test is what happens when Tcl exits.
} -cleanup {
    cd $dir
} -result ok
test filesystem-7.2 {cross-filesystem copy from vfs maintains mtime} -setup {

    namespace import -force ::tcltest::*
}

testConstraint reg 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    package require -exact registry 1.3.0
	}]} {
	testConstraint reg 1
    }
}

# determine the current locale
testConstraint english [expr {