.AS Tcl_PackageInitProc *safeInitProc
.AP Tcl_Interp *interp in
If not NULL, points to an interpreter into which the package has
already been loaded (i.e., the caller has already invoked the
appropriate initialization procedure).  NULL means the package
has not yet been incorporated into any interpreter.
.AP "const char" *pkgName in
Name of the package;  should be properly capitalized (first letter
Name of the package.
upper-case, all others lower-case).
.AP Tcl_PackageInitProc *initProc in
Procedure to invoke to incorporate this package into a trusted
interpreter.
.AP Tcl_PackageInitProc *safeInitProc in
Procedure to call to incorporate this package into a safe interpreter
(one that will execute untrusted scripts).  NULL means the package
cannot be used in safe interpreters.

.so man.macros
.BS
'\" Note:  do not modify the .SH NAME line immediately below!
.SH NAME
zipfs \- Mount and work with ZIP files within Tcl
.SH SYNOPSIS
.nf
\fBpackage require zipfs \fR?\fB1.0\fR?
\fBpackage require tcl::zipfs \fR?\fB1.0\fR?
.sp
\fBzipfs canonical\fR ?\fImntpnt\fR? \fIfilename\fR ?\fIZIPFS\fR?
\fBzipfs exists\fR \fIfilename\fR
\fBzipfs find\fR \fIdirectoryName\fR
\fBzipfs info\fR \fIfilename\fR
\fBzipfs list\fR ?(\fB\-glob\fR|\fB\-regexp\fR)? ?\fIpattern\fR?
\fBzipfs lmkimg\fR \fIoutfile inlist\fR ?\fIpassword infile\fR?

    /*
     * Register Tcl's version number.
     * TIP #268: Full patchlevel instead of just major.minor
     */

    Tcl_PkgProvideEx(interp, "Tcl", TCL_PATCH_LEVEL, &tclStubs);
    Tcl_PkgProvideEx(interp, "tcl", TCL_PATCH_LEVEL, &tclStubs);

    if (TclTommath_Init(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));
    }

    if (TclOOInit(interp) != TCL_OK) {
	Tcl_Panic("%s", TclGetString(Tcl_GetObjResult(interp)));

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
	    namesMatch = (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0);
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}

		}
		Tcl_DStringAppend(&pkgName, pkgGuess, p - pkgGuess);
		Tcl_DecrRefCount(splitPtr);
	    }
	}

	/*
	 * Fix the capitalization in the package name so that the first
	 * character is in caps (or title case) but the others are all
	 * lower-case.
	 */

	Tcl_DStringSetLength(&pkgName,
		Tcl_UtfToTitle(Tcl_DStringValue(&pkgName)));

	/*
	 * Compute the names of the two initialization functions, based on the
	 * Compute the names of the initialization functions, based on the
	 * package name.
	 */

	TclDStringAppendDString(&initName, &pkgName);
	TclDStringAppendLiteral(&initName, "_Init");
	TclDStringAppendDString(&safeInitName, &pkgName);
	Tcl_DStringSetLength(&initName,
		Tcl_UtfToTitle(Tcl_DStringValue(&initName)));
	while (strchr(Tcl_DStringValue(&initName), ':') != NULL) {
	    char *r;
	    p = Tcl_DStringValue(&initName);
	    r = strchr((char *)p, ':');
	    if ((r != NULL) && (r[1] == ':')) {
		memmove(r, r+2, strlen(r+1));
	    }
	    Tcl_DStringSetLength(&initName, strlen(p));
	}
	TclDStringAppendDString(&safeInitName, &initName);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendDString(&unloadName, &pkgName);
	TclDStringAppendDString(&unloadName, &initName);
	TclDStringAppendLiteral(&unloadName, "_Unload");
	TclDStringAppendDString(&safeUnloadName, &pkgName);
	TclDStringAppendDString(&safeUnloadName, &initName);
	TclDStringAppendLiteral(&safeUnloadName, "_SafeUnload");
	TclDStringAppendLiteral(&initName, "_Init");

	/*
	 * Call platform-specific code to load the package and find the two
	 * initialization functions.
	 */

	symbols[0] = Tcl_DStringValue(&initName);

	/*
	 * The Tcl_FindSymbol calls may have left a spurious error message in
	 * the interpreter result.
	 */

	Tcl_ResetResult(interp);
    } else {
	Tcl_DStringAppend(&initName, pkgPtr->packageName, -1);
	Tcl_DStringSetLength(&initName,
		Tcl_UtfToTitle(Tcl_DStringValue(&initName)));
	while (strchr(Tcl_DStringValue(&initName), ':') != NULL) {
	    char *r;
	    p = Tcl_DStringValue(&initName);
	    r = strchr((char *)p, ':');
	    if ((r != NULL) && (r[1] == ':')) {
		memmove(r, r+2, strlen(r+1));
	    }
	    Tcl_DStringSetLength(&initName, strlen(p));
	}
	TclDStringAppendDString(&safeInitName, &initName);
	TclDStringAppendLiteral(&safeInitName, "_SafeInit");
	TclDStringAppendLiteral(&initName, "_Init");
    }

    /*
     * Invoke the package's initialization function (either the normal one or
     * the safe one, depending on whether or not the interpreter is safe).
     */

    if (Tcl_IsSafe(target)) {
	if (pkgPtr->safeInitProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't use package in a safe interpreter: no"
		    " %s_SafeInit procedure", pkgPtr->packageName));
		    " %s procedure", Tcl_DStringValue(&safeInitName)));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "UNSAFE",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->safeInitProc(target);
    } else {
	if (pkgPtr->initProc == NULL) {
	    Tcl_SetObjResult(interp, Tcl_ObjPrintf(
		    "can't attach package to interpreter: no %s_Init procedure",
		    pkgPtr->packageName));
		    "can't attach package to interpreter: no %s procedure",
		    Tcl_DStringValue(&initName)));
	    Tcl_SetErrorCode(interp, "TCL", "OPERATION", "LOAD", "ENTRYPOINT",
		    NULL);
	    code = TCL_ERROR;
	    goto done;
	}
	code = pkgPtr->initProc(target);
    }

	if (packageName == NULL) {
	    namesMatch = 0;
	} else {
	    TclDStringClear(&pkgName);
	    Tcl_DStringAppend(&pkgName, packageName, -1);
	    TclDStringClear(&tmp);
	    Tcl_DStringAppend(&tmp, pkgPtr->packageName, -1);
	    Tcl_UtfToLower(Tcl_DStringValue(&pkgName));
	    Tcl_UtfToLower(Tcl_DStringValue(&tmp));
	    if (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0) {
	    namesMatch = (strcmp(Tcl_DStringValue(&tmp),
		    Tcl_DStringValue(&pkgName)) == 0);
		namesMatch = 1;
	    } else {
		namesMatch = 0;
	    }
	}
	TclDStringClear(&pkgName);

	filesMatch = (strcmp(pkgPtr->fileName, fullFileName) == 0);
	if (filesMatch && (namesMatch || (packageName == NULL))) {
	    break;
	}

/*
 * Scripted parts of TclOO. First, the main script (cannot be outside this
 * file).
 */

static const char *initScript =
#ifndef TCL_NO_DEPRECATED
"package ifneeded TclOO " TCLOO_PATCHLEVEL " {# Already present, OK?};"
#endif
"package ifneeded tcl::oo " TCLOO_PATCHLEVEL " {# Already present, OK?};"
"namespace eval ::oo { variable version " TCLOO_VERSION " };"
"namespace eval ::oo { variable patchlevel " TCLOO_PATCHLEVEL " };";
/* "tcl_findLibrary tcloo $oo::version $oo::version" */
/* " tcloo.tcl OO_LIBRARY oo::library;"; */

/*
 * The scripted part of the definitions of TclOO.

     * to be fully provided.
     */

    if (Tcl_EvalEx(interp, initScript, -1, 0) != TCL_OK) {
	return TCL_ERROR;
    }

#ifndef TCL_NO_DEPRECATED
    return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
    Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
    	    (void *) &tclOOStubs);
#endif
    return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
	    (void *) &tclOOStubs);
}

/*
 * ----------------------------------------------------------------------
 *
 * TclOOGetFoundation --

MODULE_SCOPE const char *
TclOOInitializeStubs(
    Tcl_Interp *interp,
    const char *version)
{
    int exact = 0;
    const char *packageName = "TclOO";
    const char *packageName = "tcl::oo";
    const char *errMsg = NULL;
    TclOOStubs *stubsPtr = NULL;
    const char *actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
	    packageName, version, exact, &stubsPtr);

    if (actualVersion == NULL) {
	packageName = "TclOO";
	actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
		packageName, version, exact, &stubsPtr);
	if (actualVersion == NULL) {
	return NULL;
	    return NULL;
	}
    }
    if (stubsPtr == NULL) {
	errMsg = "missing stub table pointer";
    } else {
	tclOOStubsPtr = stubsPtr;
	if (stubsPtr->hooks) {
	    tclOOIntStubsPtr = stubsPtr->hooks->tclOOIntStubs;

    }
#endif
    if (Tcl_OOInitStubs(interp) == NULL) {
	return TCL_ERROR;
    }
    /* TIP #268: Full patchlevel instead of just major.minor */

    if (Tcl_PkgProvideEx(interp, "Tcltest", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
    if (Tcl_PkgProvideEx(interp, "tcl::test", TCL_PATCH_LEVEL, NULL) == TCL_ERROR) {
	return TCL_ERROR;
    }

    /*
     * Create additional commands and math functions for testing Tcl.
     */

#endif
#include "tclInt.h"

/*
 * name and version of this package
 */

static const char packageName[] = "procbodytest";
static const char packageName[] = "tcl::procbodytest";
static const char packageVersion[] = "1.1";

/*
 * Name of the commands exported by this package
 */

static const char procCommand[] = "proc";

};

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_Init --
 *
 *	This function initializes the "procbodytest" package.
 *	This function initializes the "tcl::procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *

}

/*
 *----------------------------------------------------------------------
 *
 * Procbodytest_SafeInit --
 *
 *	This function initializes the "procbodytest" package.
 *	This function initializes the "tcl::procbodytest" package.
 *
 * Results:
 *	A standard Tcl result.
 *
 * Side effects:
 *	None.
 *

 * ProcBodyTestCheckObjCmd --
 *
 *  Implements the "procbodytest::check" command. Here is the command
 *  description:
 *	procbodytest::check
 *
 *  Performs an internal check that the Tcl_PkgPresent() command returns
 *  the same version number as was registered when the procbodytest package
 *  the same version number as was registered when the tcl::procbodytest package
 *  was provided.  Places a boolean in the interp result indicating the
 *  test outcome.
 *
 * Results:
 *  Returns a standard Tcl code.
 *
 *----------------------------------------------------------------------

	 */

	Tcl_GetEnsembleMappingDict(NULL, ensemble, &mapObj);
	Tcl_DictObjPut(NULL, mapObj, Tcl_NewStringObj("find", -1),
		Tcl_NewStringObj("::tcl::zipfs::find", -1));
	Tcl_CreateObjCommand(interp, "::tcl::zipfs::tcl_library_init",
		ZipFSTclLibraryObjCmd, NULL, NULL);
	Tcl_PkgProvide(interp, "zipfs", "2.0");
	Tcl_PkgProvide(interp, "tcl::zipfs", "2.0");
    }
    return TCL_OK;
#else /* !HAVE_ZLIB */
    ZIPFS_ERROR(interp, "no zlib available");
    Tcl_SetErrorCode(interp, "TCL", "ZIPFS", "NO_ZLIB", NULL);
    return TCL_ERROR;
#endif /* HAVE_ZLIB */

    TclRegisterCommandTypeName(ZlibStreamCmd, "zlibStream");

    /*
     * Formally provide the package as a Tcl built-in.
     */

#ifndef TCL_NO_DEPRECATED
    return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
    Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
#endif
    return Tcl_PkgProvide(interp, "tcl::zlib", TCL_ZLIB_VERSION);
}

/*
 *----------------------------------------------------------------------
 *	Stubs used when a suitable zlib installation was not found during
 *	configure.
 *----------------------------------------------------------------------

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testgetassocdata [llength [info commands testgetassocdata]]
testConstraint testsetassocdata [llength [info commands testsetassocdata]]
testConstraint testdelassocdata [llength [info commands testdelassocdata]]

test assocd-1.1 {testing setting assoc data} testsetassocdata {
   testsetassocdata a 1

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testasync [llength [info commands testasync]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

proc async1 {result code} {
    global aresult acode
    set aresult $result

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testevalex [llength [info commands testevalex]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]
testConstraint testcreatecommand [llength [info commands testcreatecommand]]
testConstraint exec [llength [info commands exec]]

catch {namespace delete test_ns_basic}

    variable n
    variable v
    variable msg
    variable expected

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

    testConstraint testbytestring   [llength [info commands testbytestring]]
    testConstraint testchannel      [llength [info commands testchannel]]
    testConstraint testfevent       [llength [info commands testfevent]]
    testConstraint testchannelevent [llength [info commands testchannelevent]]

    chan close $f
    string equal $result [testmainthread]
} {1}

test chan-io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
    # This test will hang in older revisions of the core.
    set out [open $path(script) w]
    chan puts $out "catch {load $::tcltestlib Tcltest}"
    chan puts $out "catch {load $::tcltestlib tcl::test}"
    chan puts $out {
	chan puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result

} -constraints {testchannel thread} -body {
    set c [open $f r]
    lappend res [catch {chan seek $c 0 start}]
    testchannel cut $c
    lappend res [catch {chan seek $c 0 start}]
    set tid [thread::create -preserved]
    thread::send $tid [list set c $c]
    thread::send $tid {load {} Tcltest}
    thread::send $tid {load {} tcl::test}
    lappend res [thread::send $tid {
	testchannel splice $c
	set res [catch {chan seek $c 0 start}]
	chan close $c
	set res
    }]
} -cleanup {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testchmod       [llength [info commands testchmod]]
testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testvolumetype  [llength [info commands testvolumetype]]
testConstraint time64bit [expr {
    $::tcl_platform(pointerSize) >= 8 ||
    [llength [info command testsize]] && [testsize st_mtime] >= 8

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]
testConstraint testobj [llength [info commands testobj]]
source [file join [file dirname [info script]] internals.tcl]
namespace import -force ::tcltest::internals::*


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testcmdinfo  [llength [info commands testcmdinfo]]
testConstraint testcmdtoken [llength [info commands testcmdtoken]]

test cmdinfo-1.1 {command procedure and clientData} {testcmdinfo} {
    testcmdinfo create x1
    testcmdinfo get x1

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Big test for correct ordering of data in [expr]

proc testIEEE {} {
    variable ieeeValues
    binary scan [binary format dd -1.0 1.0] c* c
    switch -exact -- $c {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Constrain memory leak tests
testConstraint memory [llength [info commands memory]]

catch {unset a}

test compExpr-1.1 {TclCompileExpr procedure, successful expr parse and compile} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint exec       [llength [info commands exec]]
testConstraint memory     [llength [info commands memory]]
testConstraint testevalex [llength [info commands testevalex]]

# The following tests are very incomplete, although the rest of the
# test suite covers this file fairly well.

    interp recursionlimit ti [expr {10000+50}]
    ti eval {set result {}}
} -body {
    # Test different compilation variants (instructions evalStk, invokeStk, etc),
    # with 1500 (1000 in debug) nested scripts (bodies). If you get SO/SF exceptions on some low-stack
    # boxes or systems, please don't decrease it (either provide a constraint)
    ti eval {foreach cmd {eval "if 1" try catch} {
	set c [gencode [expr {![::tcl::pkgconfig get debug] ? 1500 : 1000}] $cmd]
	set c [gencode [expr {"debug" ni [split [package provide tcl] .] ? 1500 : 1000}] $cmd]
	if 1 $c
    }}
    ti eval {set result}
} -result {1 1 1 1}
test compile-13.3 {TclCompileScript: testing check of max depth by nested scripts compilation} -setup {
    _ti_gencode
    interp recursionlimit ti 100

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test pkgconfig-1.1 {query keys} {
test pkgconfig-1.1 {query keys} -body {
    lsort [::tcl::pkgconfig list]
} {64bit bindir,install bindir,runtime compile_debug compile_stats debug dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime mem_debug optimized profiled scriptdir,install scriptdir,runtime threaded zipfile,runtime}
} -match glob -result {*bindir,install bindir,runtime*dllfile,runtime docdir,install docdir,runtime includedir,install includedir,runtime libdir,install libdir,runtime*scriptdir,install scriptdir,runtime*zipfile,runtime}
test pkgconfig-1.2 {query keys multiple times} {
    string compare [::tcl::pkgconfig list] [::tcl::pkgconfig list]
} 0
test pkgconfig-1.3 {query value multiple times} {
    string compare \
	    [::tcl::pkgconfig get bindir,install] \
	    [::tcl::pkgconfig get bindir,install]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]
testConstraint memory [llength [info commands memory]]

set lambda [list {{start 0} {stop 10}} {
    # init
    set i    $start

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testdcall [llength [info commands testdcall]]

test dcall-1.1 {deletion callbacks} testdcall {
    lsort -increasing [testdcall 1 2 3]
} {1 2 3}
test dcall-1.2 {deletion callbacks} testdcall {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testdstring [llength [info commands testdstring]]
if {[testConstraint testdstring]} {
    testdstring free
}

test dstring-1.1 {appending and retrieving} -constraints testdstring -setup {

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

catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    package require -exact tcl::test [info patchlevel]
}

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

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

# [exec] is required here to see the actual environment received by child
# processes.
proc getenv {} {
    global printenvScript
    catch {exec [interpreter] $printenvScript} out

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require tcltest 2.5
namespace import -force ::tcltest::*

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


testConstraint testfilehandler [llength [info commands testfilehandler]]
testConstraint testexithandler [llength [info commands testexithandler]]
testConstraint testfilewait [llength [info commands testfilewait]]
testConstraint exec [llength [info commands exec]]

# file/exec test than a bgerror test.

# end of bgerror tests
catch {rename bgerror {}}

test event-8.1 {Tcl_CreateExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "catch {load $::tcltestlib tcl::test}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 6
even 4
odd 41
}

test event-9.1 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "catch {load $::tcltestlib tcl::test}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 16
even 6
even 4
}
test event-9.2 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "catch {load $::tcltestlib tcl::test}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 4"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 16
even 6
odd 41
}
test event-9.3 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "catch {load $::tcltestlib tcl::test}"
    puts $child "testexithandler create 41; testexithandler create 4"
    puts $child "testexithandler create 6; testexithandler delete 6"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 16
even 4
odd 41
}
test event-9.4 {Tcl_DeleteExitHandler procedure} {stdio testexithandler} {
    set child [open |[list [interpreter]] r+]
    puts $child "catch {load $::tcltestlib Tcltest}"
    puts $child "catch {load $::tcltestlib tcl::test}"
    puts $child "testexithandler create 41; testexithandler delete 41"
    puts $child "testexithandler create 16; exit"
    flush $child
    set result [read $child]
    close $child
    return $result
} {even 16

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

# All tests require the "exec" command.
# Skip them if exec is not defined.
testConstraint exec [llength [info commands exec]]
testConstraint noosx [expr {![info exists ::env(TRAVIS_OSX_IMAGE)] || ![string match xcode* $::env(TRAVIS_OSX_IMAGE)]}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename foo ""}
catch {unset x}
catch {unset y}
catch {unset msg}

    catch {interp delete child}
} -result {0 0}
test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
    interp create child
} -constraints testexprlongobj -body {
    set e { [llength {}]+1 }
    set result {}
    load {} Tcltest child
    load {} tcl::test child
    interp alias {} e child testexprlongobj
    lappend result [e $e]
    interp delete child
    interp create child
    load {} Tcltest child
    load {} tcl::test child
    interp alias {} e child testexprlongobj
    lappend result [e $e]
} -cleanup {
    interp delete child
} -result {{This is a result: 1} {This is a result: 1}}
test execute-6.12 {Tcl_ExprObj: exprcode interp validation} -setup {
    interp create child

    invoked from within
"catch \[list error FOO\] m o"} -errorline 2}

test execute-8.6 {Compile epoch bump in global level (bug [fa6bf38d07])} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	catch [list package require -exact tcl::test [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    child eval {

} -cleanup {
    interp delete child
} -result [lrepeat 4 A B]
test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), exception case} -setup {
    interp create child
    child eval {
	package require tcltest 2.5
	catch [list package require -exact Tcltest [info patchlevel]]
	catch [list package require -exact tcl::test [info patchlevel]]
	::tcltest::loadTestedCommands
	if {[namespace which -command testbumpinterpepoch] eq ""} {
	  proc testbumpinterpepoch {} { rename ::set ::dummy; rename ::dummy ::set }
	}
    }
} -body {
    set res {}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testexprlong   [llength [info commands testexprlong]]
testConstraint testexprdouble [llength [info commands testexprdouble]]
testConstraint testexprstring [llength [info commands testexprstring]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Determine if "long int" type is a 32 bit number and if the wide
# type is a 64 bit number on this machine.

testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

cd [temporaryDirectory]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testchmod [llength [info commands testchmod]]
testConstraint winVista 0
testConstraint winXP 0

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}


::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testsetplatform [llength [info commands testsetplatform]]
testConstraint testtranslatefilename [llength [info commands testtranslatefilename]]
testConstraint linkDirectory 1
testConstraint symbolicLinkFile 1
if {[testConstraint win]} {
    if {$::tcl_platform(osVersion) < 5.0 \

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

testConstraint loaddll 0
catch {
    ::tcltest::loadTestedCommands
    package require -exact Tcltest [info patchlevel]
    package require -exact tcl::test [info patchlevel]
    set ::ddever [package require dde]
    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]
    set ::regver  [package require registry]
    set ::reglib [lindex [package ifneeded registry $::regver] 1]
    testConstraint loaddll 1
}

# Test for commands defined in Tcltest executable
# Test for commands defined in tcl::test package
testConstraint testfilesystem  	    [llength [info commands ::testfilesystem]]
testConstraint testsetplatform 	    [llength [info commands ::testsetplatform]]
testConstraint testsimplefilesystem [llength [info commands ::testsimplefilesystem]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

cd [tcltest::temporaryDirectory]
makeFile "test file" gorp.file

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testgetint [llength [info commands testgetint]]
testConstraint testdoubleobj [llength [info commands testdoubleobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint longIs64bit [expr {$tcl_platform(wordSize) == 8}]

test get-1.1 {Tcl_GetInt procedure} testgetint {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testindexobj [llength [info commands testindexobj]]
testConstraint testparseargs [llength [info commands testparseargs]]

test indexObj-1.1 {exact match} testindexobj {
    testindexobj 1 1 xyz abc def xyz alm
} {2}

# DO NOT DELETE THIS LINE

if {{::tcltest} ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
testConstraint zlib [llength [info commands zlib]]

# Set up namespaces needed to test operation of "info args", "info body",
# "info default", and "info procs" with imported procedures.

catch {namespace delete test_ns_info1 test_ns_info2}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testinterpdelete [llength [info commands testinterpdelete]]

set hidden_cmds {cd encoding exec exit fconfigure file glob load open pwd socket source tcl:encoding:dirs tcl:encoding:system tcl:file:atime tcl:file:attributes tcl:file:copy tcl:file:delete tcl:file:dirname tcl:file:executable tcl:file:exists tcl:file:extension tcl:file:isdirectory tcl:file:isfile tcl:file:link tcl:file:lstat tcl:file:mkdir tcl:file:mtime tcl:file:nativename tcl:file:normalize tcl:file:owned tcl:file:readable tcl:file:readlink tcl:file:rename tcl:file:rootname tcl:file:size tcl:file:stat tcl:file:tail tcl:file:tempdir tcl:file:tempfile tcl:file:type tcl:file:volumes tcl:file:writable tcl:info:cmdtype tcl:info:nameofexecutable tcl:process:autopurge tcl:process:list tcl:process:purge tcl:process:status tcl:zipfs:lmkimg tcl:zipfs:lmkzip tcl:zipfs:mkimg tcl:zipfs:mkkey tcl:zipfs:mkzip tcl:zipfs:mount tcl:zipfs:mount_data tcl:zipfs:unmount unload}

foreach i [interp children] {
  interp delete $i

    variable n
    variable v
    variable msg
    variable expected

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

testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testchannel      [llength [info commands testchannel]]
testConstraint testfevent       [llength [info commands testfevent]]
testConstraint testchannelevent [llength [info commands testchannelevent]]

    string equal $result [testmainthread]
} {1}

test io-60.1 {writing illegal utf sequences} {fileevent testbytestring} {
    # This test will hang in older revisions of the core.

    set out [open $path(script) w]
    puts $out "catch {load $::tcltestlib Tcltest}"
    puts $out "catch {load $::tcltestlib tcl::test}"
    puts $out {
	puts [testbytestring \xe2]
	exit 1
    }
    proc readit {pipe} {
	variable x
	variable result

    set     res {}
    lappend res [catch {seek $c 0 start}]
    testchannel cut $c
    lappend res [catch {seek $c 0 start}]

    set tid [thread::create -preserved]
    thread::send $tid [list set c $c]
    thread::send $tid {load {} Tcltest}
    thread::send $tid {load {} tcl::test}
    lappend res [thread::send $tid {
	testchannel splice $c
	set res [catch {seek $c 0 start}]
	close $c
	set res
    }]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

package require tcltests

# Custom constraints used in this file
testConstraint testchannel	[llength [info commands testchannel]]

#----------------------------------------------------------------------

test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {

    set ida [interp create];#puts <<$ida>>
    set idb [interp create];#puts <<$idb>>

    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
    load {} tcl::test $ida
    load {} tcl::test $idb

    # Set up channel in interpreter
    interp eval $ida $helperscript
    set chan [interp eval $ida {
	proc foo {args} {oninit seek; onfinal; track; return}
	set chan [chan create {r w} foo]
	fconfigure $chan -buffering none

test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -match glob -body {

    set ida [interp create];#puts <<$ida>>
    set idb [interp create];#puts <<$idb>>

    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
    load {} tcl::test $ida
    load {} tcl::test $idb

    # Set up channel in thread
    set chan [interp eval $ida $helperscript]
    set chan [interp eval $ida {
	proc foo {args} {
	    oninit; onfinal; track;
	    # destroy interpreter during channel access

## result. A channel is transfered into the thread as well, and list of
## configuation variables

proc inthread {chan script args} {
    # Test thread.

    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}
    thread::send $tid {load {} tcl::test}

    # Init thread configuration.
    # - Listed variables
    # - Id of main thread
    # - A number of helper commands

    foreach v $args {

    set tid [thread::create {
	proc LOG {text} {
	    #puts stderr "\t\t\t\t\t\t[thread::id]: $text"
	    return
	}
	LOG THREAD-STARTED
	load {} Tcltest
	load {} tcl::test
	proc bgerror s {
	    LOG BGERROR:$s
	}
	vwait forever
	LOG THREAD-DONE
    }]

# thread B, destroy the origin thread (A) before or during access from
# B. Must not crash, must return proper errors.

test iocmd.tf-32.0 {origin thread of moved channel gone} -match glob -body {

    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    thread::send $tida {load {} tcl::test}

    set tidb [thread::create -preserved];#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
    thread::send $tidb {load {} tcl::test}

    # Set up channel in thread
    thread::send $tida $helperscript
    set chan [thread::send $tida {
	proc foo {args} {oninit seek; onfinal; track; return}
	set chan [chan create {r w} foo]
	fconfigure $chan -buffering none

# Use constraints to skip this test while valgrinding so this expected leak
# doesn't prevent a finding of "leak-free".
#
test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -match glob -body {

    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    thread::send $tida {load {} tcl::test}
    set tidb [thread::create -preserved];#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
    thread::send $tidb {load {} tcl::test}

    # Set up channel in thread
    thread::send $tida $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    oninit; onfinal; track;
	    # destroy thread during channel access

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Custom constraints used in this file
testConstraint testchannel [llength [info commands testchannel]]
testConstraint thread [expr {0 == [catch {package require Thread 2.7-}]}]

# testchannel cut|splice  Both needed to test the reflection in threads.
# thread::send

# 'Pull the rug' tests. Create channel in a interpreter A, move to other
# interpreter B, destroy the origin interpreter (A) before or during access
# from B. Must not crash, must return proper errors.
test iortrans-11.0 {origin interpreter of moved transform gone} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
    load {} tcl::test $ida
    load {} tcl::test $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel and transform in interpreter
    interp eval $ida $helperscript
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	variable tempchan

    tempdone
    interp delete $idb
} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}
test iortrans-11.1 {origin interpreter of moved transform destroyed during access} -setup {
    set ida [interp create];	#puts <<$ida>>
    set idb [interp create];	#puts <<$idb>>
    # Magic to get the test* commands in the children
    load {} Tcltest $ida
    load {} Tcltest $idb
    load {} tcl::test $ida
    load {} tcl::test $idb
} -constraints {testchannel} -match glob -body {
    # Set up channel in thread
    set chan [interp eval $ida $helperscript]
    interp eval $ida [list ::variable tempchan [tempchan]]
    interp transfer {} $::tempchan $ida
    set chan [interp eval $ida {
	proc foo {args} {

} -cleanup {
    interp delete $idb
    tempdone
} -result {Owner lost}
test iortrans-11.2 {delete interp of reflected transform} -setup {
    interp create child
    # Magic to get the test* commands into the child
    load {} Tcltest child
    load {} tcl::test child
} -constraints {testchannel} -body {
    # Get base channel into the child
    set c [tempchan]
    testchannel cut $c
    interp eval child [list testchannel splice $c]
    interp eval child [list set c $c]
    child eval {

## Helper command. Runs a script in a separate thread and returns the result.
## A channel is transfered into the thread as well, and a list of configuation
## variables

proc inthread {chan script args} {
    # Test thread.
    set tid [thread::create -preserved]
    thread::send $tid {load {} Tcltest}
    thread::send $tid {load {} tcl::test}

    # Init thread configuration.
    # - Listed variables
    # - Id of main thread
    # - A number of helper commands

    foreach v $args {

# 'Pull the rug' tests. Create channel in a thread A, move to other thread B,
# destroy the origin thread (A) before or during access from B. Must not
# crash, must return proper errors.

test iortrans.tf-11.0 {origin thread of moved transform gone} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    thread::send $tida {load {} tcl::test}
    set tidb [thread::create -preserved];	#puts <<$tida>>
    thread::send $tidb {load {} Tcltest}
    thread::send $tidb {load {} tcl::test}
} -constraints {testchannel thread} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write

} -result {1 {Owner lost} 0 0 1 {Owner lost} 1 {Owner lost} 1 {Owner lost}}

testConstraint notValgrind [expr {![testConstraint valgrind]}]

test iortrans.tf-11.1 {origin thread of moved transform destroyed during access} -setup {
    #puts <<$tcltest::mainThread>>main
    set tida [thread::create -preserved];	#puts <<$tida>>
    thread::send $tida {load {} Tcltest}
    thread::send $tida {load {} tcl::test}
    set tidb [thread::create -preserved];	#puts <<$tidb>>
    thread::send $tidb {load {} Tcltest}
    thread::send $tidb {load {} tcl::test}
} -constraints {testchannel thread notValgrind} -match glob -body {
    # Set up channel in thread
    thread::send $tida $helperscript
    thread::send $tidb $helperscript
    set chan [thread::send $tida {
	proc foo {args} {
	    handle.initialize clear drain flush limit? read write

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

namespace eval ::tcl::test::iogt {
    namespace import ::tcltest::*

testConstraint testchannel [llength [info commands testchannel]]

set path(dummy) [makeFile {abcdefghijklmnopqrstuvwxyz0123456789,./?><;'\|":[]\}\{`~!@#$%^&*()_+-=

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

set minus -
testConstraint testevalex [llength [info commands testevalex]]

# Tests of Tcl_LindexObjCmd, NOT COMPILED

test lindex-1.1 {wrong # args} testevalex {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testlink [llength [info commands testlink]]
testConstraint testlinkarray [llength [info commands testlinkarray]]

foreach i {int real bool string} {
    unset -nocomplain $i
}

test link-0.1 {leak test} {testlink} {
    interp create i
    load {} Tcltest i
    load {} tcl::test i
    i eval {
	testlink create 1 0 0 0 0 0 0 0 0 0 0 0 0 0
	namespace delete ::
    }
    interp delete i
} {}


if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]

catch {unset x}
test listobj-1.1 {Tcl_GetListObjType} emptyTest {
    # Test removed; tested an internal detail
    # that's no longer correct, and duplicated test obj-1.1

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}
# Tests require the existence of one of the DLLs in the dltest directory.

	[list $dll $loaded] {
    load -global [file join $testDir pkga$ext]
    list [pkga_eq abc def] [lsort [info commands pkga_*]]
} {0 {pkga_eq pkga_quote}}
interp create -safe child
test load-2.2 {loading into a safe interpreter, with package name conversion} \
	[list $dll $loaded] {
    load -lazy [file join $testDir pkgb$ext] pKgB child
    load -lazy [file join $testDir pkgb$ext] pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
	    [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test load-2.3 {loading with no _Init procedure} -constraints [list $dll $loaded] \
-body {
    list [catch {load [file join $testDir pkgc$ext] foo} msg] $msg $errorCode
} -match glob \

test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
    list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
} {0 {}}
test load-4.2 {reloading package into same interpreter} -setup {
    catch {load [file join $testDir pkga$ext] pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
    load [file join $testDir pkga$ext] pkgb
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"Pkga\""
} -result "file \"[file join $testDir pkga$ext]\" is already loaded for package \"pkga\""

test load-5.1 {file name not specified and no static package: pick default} -setup {
    catch {interp delete x}
    interp create x
} -constraints [list $dll $loaded] -body {
    load -global [file join $testDir pkga$ext] pkga
    load {} pkga x
    info loaded x
} -cleanup {
    interp delete x
} -result [list [list [file join $testDir pkga$ext] Pkga]]
} -result [list [list [file join $testDir pkga$ext] pkga]]

# On some platforms, like SunOS 4.1.3, these tests can't be run because
# they cause the process to exit.
#
# As of 2005, such ancient broken systems no longer matter.

test load-6.1 {errors loading file} [list $dll $loaded] {
    catch {load foo foo}
} {1}

test load-7.1 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg Test 1 0
    load {} Test
    load {} Test child
    teststaticpkg test 1 0
    load {} test
    load {} test child
    list [set x] [child eval set x]
} {loaded loaded}
test load-7.2 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg Another 0 0
    load {} Another
    teststaticpkg another 0 0
    load {} another
    child eval {set x "not loaded"}
    list [catch {load {} Another child} msg] $msg \
    list [catch {load {} another child} msg] $msg \
	[child eval set x] [set x]
} {1 {can't use package in a safe interpreter: no Another_SafeInit procedure} {not loaded} loaded}
test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
    set x "not loaded"
    teststaticpkg More 0 1
    load {} More
    teststaticpkg more 0 1
    load {} more
    set x
} {not loaded}
catch {load [file join $testDir pkga$ext] pkga}
catch {load [file join $testDir pkgb$ext] pkgb}
catch {load [file join $testDir pkge$ext] pkge}
set currentRealPackages [list [list [file join $testDir pkge$ext] Pkge] [list [file join $testDir pkgb$ext] Pkgb] [list [file join $testDir pkga$ext] Pkga]]
set currentRealPackages [list [list [file join $testDir pkge$ext] pkge] [list [file join $testDir pkgb$ext] pkgb] [list [file join $testDir pkga$ext] pkga]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
    teststaticpkg Test 1 0
    teststaticpkg Another 0 0
    teststaticpkg More 0 1
    teststaticpkg test 1 0
    teststaticpkg another 0 0
    teststaticpkg more 0 1
} -constraints [list teststaticpkg $dll $loaded] -body {
    teststaticpkg Double 0 1
    teststaticpkg Double 0 1
    teststaticpkg double 0 1
    teststaticpkg double 0 1
    info loaded
} -result [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]
} -result [list {{} double} {{} more} {{} another} {{} test} {*}$currentRealPackages {*}$alreadyTotalLoaded]

testConstraint teststaticpkg_8.x 0
if {[testConstraint teststaticpkg]} {
    catch {
	teststaticpkg Test 1 1
	teststaticpkg Another 0 1
	teststaticpkg More 0 1
	teststaticpkg Double 0 1
	teststaticpkg test 1 1
	teststaticpkg another 0 1
	teststaticpkg more 0 1
	teststaticpkg double 0 1
	testConstraint teststaticpkg_8.x 1
    }
}

test load-8.1 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
} [lsort -index 1 [list {{} double} {{} more} {{} another} {{} test} {*}$currentRealPackages {*}$alreadyTotalLoaded]]
test load-8.2 {TclGetLoadedPackages procedure} -constraints {teststaticpkg_8.x} -body {
    info loaded gorp
} -returnCodes error -result {could not find interpreter "gorp"}
test load-8.3a {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded {}]
} [lsort -index 1 [list {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga] [list [file join $testDir pkgb$ext] Pkgb] {*}$alreadyLoaded]]
} [lsort -index 1 [list {{} double} {{} more} {{} another} {{} test} [list [file join $testDir pkga$ext] pkga] [list [file join $testDir pkgb$ext] pkgb] {*}$alreadyLoaded]]
test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    lsort -index 1 [info loaded child]
} [lsort -index 1 [list {{} Test} [list [file join $testDir pkgb$ext] Pkgb]]]
} [lsort -index 1 [list {{} test} [list [file join $testDir pkgb$ext] pkgb]]]
test load-8.4 {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $loaded] {
    load [file join $testDir pkgb$ext] pkgb
    list [lsort -index 1 [info loaded {}]] [lsort [info commands pkgb_*]]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] Pkgb] {{} Double} {{} More} {{} Another} {{} Test} [list [file join $testDir pkga$ext] Pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
} [list [lsort -index 1 [concat [list [list [file join $testDir pkgb$ext] pkgb] {{} double} {{} more} {{} another} {{} test} [list [file join $testDir pkga$ext] pkga]] $alreadyLoaded]] {pkgb_demo pkgb_sub pkgb_unsafe}]
interp delete child

test load-9.1 {Tcl_StaticPackage, load already-loaded package into another interp} -setup {
    interp create child1
    interp create child2
    load {} Tcltest child1
    load {} Tcltest child2
    load {} tcl::test child1
    load {} tcl::test child2
} -constraints {teststaticpkg} -body {
    child1 eval { teststaticpkg Loadninepointone 0 1 }
    child2 eval { teststaticpkg Loadninepointone 0 1 }
    child1 eval { teststaticpkg loadninepointone 0 1 }
    child2 eval { teststaticpkg loadninepointone 0 1 }
    list [child1 eval { info loaded {} }] \
	[child2 eval { info loaded {} }]
} -match glob -cleanup {
    interp delete child1
    interp delete child2
} -result {{{{} Loadninepointone} {* Tcltest}} {{{} Loadninepointone} {* Tcltest}}}
} -result {{{{} loadninepointone} {* tcl::test}} {{{} loadninepointone} {* tcl::test}}}

test load-10.1 {load from vfs} -setup {
    set dir [pwd]
    cd $testDir
    testsimplefilesystem 1
} -constraints [list $dll $loaded testsimplefilesystem] -body {
    list [catch {load simplefs:/pkgd$ext pkgd} msg] $msg

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testpurebytesobj [llength [info commands testpurebytesobj]]

test lrange-1.1 {range of list elements} {
    lrange {a b c d} 1 2
} {b c}
test lrange-1.2 {range of list elements} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

proc failTrace {name1 name2 op} {
    error "trace failed"
}

testConstraint testevalex [llength [info commands testevalex]]

# This file contains a collection of tests for generic/tclMain.c.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

namespace eval ::tcl::test::main {
    namespace import ::tcltest::*

    # Is [exec] defined?
    testConstraint exec [llength [info commands exec]]

    # Is the Tcltest package loaded?
    # Is the tcl::test package loaded?
    #	- that is, the special C-coded testing commands in tclTest.c
    #   - tests use testing commands introduced in Tcltest 8.4
    testConstraint Tcltest [expr {
	[llength [package provide Tcltest]]
	&& [package vsatisfies [package provide Tcltest] 8.5-]}]
    testConstraint tcl::test [expr {
	[llength [package provide tcl::test]]
	&& [package vsatisfies [package provide tcl::test] 8.5-]}]

    # Procedure to simulate interactive typing of commands, line by line
    proc type {chan script} {
	foreach line [split $script \n] {
	    if {[catch {
	        puts $chan $line
	        flush $chan

    } -result {0 {-enc utf-8 script}}

    # Tests Tcl_Main-2.*: application-initialization procedure

    test Tcl_Main-2.1 {
	Tcl_Main: appInitProc returns error
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {puts "In script"} script
    } -body {
	exec [interpreter] script -appinitprocerror >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
	removeFile script
    } -result "application-specific initialization failed: \nIn script\n"

    test Tcl_Main-2.2 {
	Tcl_Main: appInitProc returns error
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {puts "In script"} -appinitprocerror >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "application-specific initialization failed: \nIn script\n"

    test Tcl_Main-2.3 {
	Tcl_Main: appInitProc deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {puts "In script"} script
    } -body {
	exec [interpreter] script -appinitprocdeleteinterp >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
	removeFile script
    } -result "application-specific initialization failed: \n"

    test Tcl_Main-2.4 {
	Tcl_Main: appInitProc deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocdeleteinterp >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "application-specific initialization failed: \n"

    test Tcl_Main-2.5 {
	Tcl_Main: appInitProc closes stderr
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocclosestderr >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f

	removeFile script
    } -match glob -result [join [list 1 {child process exited abnormally}\
	"missing close-brace\n    while executing*"] \n]

    test Tcl_Main-3.5 {
	Tcl_Main: startup script sets main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code
		}

	file delete result
	removeFile script
    } -result "event\nExit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-3.6 {
	Tcl_Main: startup script sets main loop and closes stdin
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {
		close stdin
		testsetmainloop
		rename exit _exit
		proc exit {code} {
		    puts "In exit"

	file delete result
	removeFile script
    } -result "event\nExit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-3.7 {
	Tcl_Main: startup script deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code
		}

	file delete result
	removeFile script
    } -result "even 0\n"

    test Tcl_Main-3.8 {
	Tcl_Main: startup script deletes interp and sets mainloop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	makeFile {
		testsetmainloop
		rename exit _exit
		proc exit {code} {
		    puts "In exit"
		    _exit $code

    } -result {}

    # Tests Tcl_Main-4.*: rc file evaluation

    test Tcl_Main-4.1 {
	Tcl_Main: rcFile evaluation deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	set rc [makeFile {testinterpdelete {}} rc]
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocsetrcfile $rc >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
	removeFile rc
    } -result "application-specific initialization failed: \n"

    test Tcl_Main-4.2 {
	Tcl_Main: rcFile evaluation closes stdin
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	set rc [makeFile {close stdin} rc]
    } -body {
	exec [interpreter] << {puts "In script"} \
		-appinitprocsetrcfile $rc >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
	removeFile rc
    } -result "application-specific initialization failed: \n"

    test Tcl_Main-4.3 {
	Tcl_Main: rcFile evaluation closes stdin and sets main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	set rc [makeFile {
		close stdin
		testsetmainloop
		after 0 testexitmainloop
		testexithandler create 0
		rename exit _exit

	removeFile rc
    } -result "application-specific initialization failed:\
	\nExit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-4.4 {
	Tcl_Main: rcFile evaluation sets main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	set rc [makeFile {
		testsetmainloop
		after 0 testexitmainloop
		testexithandler create 0
		rename exit _exit
		proc exit code {

	removeFile rc
    } -result "application-specific initialization failed:\
	\nExit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-4.5 {
        Tcl_Main: Bug 1481986
    } -constraints {
        exec Tcltest
        exec tcl::test
    } -setup {
        set rc [makeFile {
                testsetmainloop
                after 0 {puts "Event callback"}
        } rc]
    } -body {
        set f [open "|[list [interpreter] -appinitprocsetrcfile $rc]" w+]

	file delete result
    } -result "bar\n"

    test Tcl_Main-5.8 {
	Tcl_Main: interactive mode: close stdin
		-> main loop & [exit] & exit handlers
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}

	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-5.9 {
	Tcl_Main: interactive mode: delete interp
		-> main loop & exit handlers, but no [exit]
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}

	close $f
	file delete result
    } -result "Exit MainLoop\neven 0\n"

    test Tcl_Main-5.10 {
	Tcl_Main: exit main loop in mid-interactive command
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -setup {
	catch {set f [open "|[list [interpreter]]" w+]}
	catch {chan configure $f -blocking 0}
    } -body {
	type $f "testsetmainloop
	         after 2000 testexitmainloop
	         puts \{1 2"
	after 4000
	type $f "3 4\}"
	set code1 [catch {gets $f} line1]
	set code2 [catch {gets $f} line2]
	set code3 [catch {gets $f} line3]
	list $code1 $line1 $code2 $line2 $code3 $line3
    } -cleanup {
	close $f
    } -result [list 0 {Exit MainLoop} 0 {1 2} 0 {3 4}]

    test Tcl_Main-5.11 {
	Tcl_Main: EOF in interactive main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}

	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-5.12 {
	Tcl_Main: close stdin in interactive main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}

	close $f
	file delete result
    } -result "1\n% "

    test Tcl_Main-6.2 {
	Tcl_Main: prompt deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		set tcl_prompt1 {testinterpdelete {}}
		set tcl_interactive 1
		puts "not reached"
	} >& result
	set f [open result]

	close $f
	file delete result
    } -result "1\n% YES\n"

    test Tcl_Main-6.5 {
	Tcl_Main: interactive entry to main loop
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		set tcl_interactive 1
		testsetmainloop
		testexitmainloop} >& result
	set f [open result]
	read $f

    } -result "1\n% % "

    # Tests Tcl_Main-7.*: exiting

    test Tcl_Main-7.1 {
	Tcl_Main: [exit] defined as no-op -> still have exithandlers
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		proc exit args {}
		testexithandler create 0
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "even 0\n"

    test Tcl_Main-7.2 {
	Tcl_Main: [exit] defined as no-op -> still have exithandlers
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		proc exit args {}
		testexithandler create 0
		after 0 testexitmainloop
		testsetmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\neven 0\n"

    # Tests Tcl_Main-8.*: StdinProc operations

    test Tcl_Main-8.1 {
	StdinProc: handles non-blocking stdin
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		chan configure stdin -blocking 0
		testexitmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\n"

    test Tcl_Main-8.2 {
	StdinProc: handles stdin EOF
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		testexithandler create 0
		rename exit _exit
		proc exit code {
		    puts "In exit"

	close $f
	file delete result
    } -result "Exit MainLoop\nIn exit\neven 0\n"

    test Tcl_Main-8.3 {
	StdinProc: handles interactive stdin EOF
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		testexithandler create 0
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code
		}
		set tcl_interactive 1} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "1\n% even 0\n"

    test Tcl_Main-8.4 {
	StdinProc: handles stdin close
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		rename exit _exit
		proc exit code {
		    puts "In exit"
		    _exit $code

	close $f
	file delete result
    } -result "1\nExit MainLoop\nIn exit\n"

    test Tcl_Main-8.5 {
	StdinProc: handles interactive stdin close
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		set tcl_interactive 1
		rename exit _exit
		proc exit code {
		    puts "In exit"

	close $f
	file delete result
    } -result "1\n% % % after#0\n% after#1\n% 1\nExit MainLoop\nIn exit\n"

    test Tcl_Main-8.6 {
	StdinProc: handles event loop re-entry
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		after 100 {puts 1; set delay 1}
		vwait delay
		puts 2
		testexitmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "1\n2\nExit MainLoop\n"

    test Tcl_Main-8.7 {
	StdinProc: handling of errors
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		error foo
		testexitmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "foo\nExit MainLoop\n"

    test Tcl_Main-8.8 {
	StdinProc: handling of errors, closed stderr
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		close stderr
		error foo
		testexitmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "Exit MainLoop\n"

    test Tcl_Main-8.9 {
	StdinProc: interactive output
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		set tcl_interactive 1
		testexitmainloop} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "1\n% % Exit MainLoop\n"

    test Tcl_Main-8.10 {
	StdinProc: interactive output, closed stdout
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		close stdout
		set tcl_interactive 1
		testexitmainloop
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result {}

    test Tcl_Main-8.11 {
	StdinProc: prompt deletes interp
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		set tcl_prompt1 {testinterpdelete {}}
		set tcl_interactive 1} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "1\n"

    test Tcl_Main-8.12 {
	StdinProc: prompt closes stdin
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << {
		testsetmainloop
		set tcl_prompt1 {close stdin}
		after 100 testexitmainloop
		set tcl_interactive 1
		puts "not reached"
	} >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result
    } -result "1\nExit MainLoop\n"

    test Tcl_Main-8.13 {
	Bug 1775878
    } -constraints {
	exec Tcltest
	exec tcl::test
    } -body {
	exec [interpreter] << "testsetmainloop\nputs \\\npwd\ntestexitmainloop" >& result
	set f [open result]
	read $f
    } -cleanup {
	close $f
	file delete result

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testhashsystemhash [llength [info commands testhashsystemhash]]

test misc-1.1 {error in variable ref. in command in array reference} {
    proc tstProc {} {
	global a

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
testConstraint memory [llength [info commands memory]]

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

#
# REMARK: the tests for 'namespace upvar' are not done here. They are to be
# found in the file 'upvar.test'.
#

# Clear out any namespaces called test_ns_*

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testevent [llength [info commands testevent]]

test notify-1.1 {Tcl_QueueEvent and delivery of a single event} \
    -constraints {testevent} \
    -body {
	set delivered {}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]

#
# The tests that risked blowing the C stack on failure have been removed: we
# can now actually measure using testnrelevels.
#

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint longIs32bit [expr {$tcl_platform(wordSize) == 4}]
testConstraint wideIs64bit [expr {wide(0x8000000000000000) < 0}]

test obj-1.1 {Tcl_AppendAllObjTypes, and InitTypeTable, Tcl_RegisterObjType} testobj {
    set r 1

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2013 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcl::oo 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

# The foundational objects oo::object and oo::class are sensitive to reference
# counting errors and are deallocated only when an interp is deleted, so in

	return [expr {$end - $tmp}]
    }
}

test oo-0.1 {basic test of OO's ability to clean up its initial state} {
    interp create t
    t eval {
	package require TclOO
	package require tcl::oo
    }
    interp delete t
} {}
test oo-0.2 {basic test of OO's ability to clean up its initial state} {
    set i [interp create]
    interp eval $i {
	package require TclOO
	package require tcl::oo
	namespace delete ::
    }
    interp delete $i
} {}
test oo-0.3 {basic test of OO's ability to clean up its initial state} -body {
    leaktest {
        [oo::object new] destroy

	interp delete foo
    }
} 0
test oo-0.6 {cleaning the core class pair; way #1} -setup {
    interp create t
} -body {
    t eval {
	package require TclOO
	package require tcl::oo
	namespace path oo
	list [catch {class destroy} m] $m [catch {object destroy} m] $m
    }
} -cleanup {
    interp delete t
} -result {0 {} 1 {invalid command name "object"}}
test oo-0.7 {cleaning the core class pair; way #2} -setup {
    interp create t
} -body {
    t eval {
	package require TclOO
	package require tcl::oo
	namespace path oo
	list [catch {object destroy} m] $m [catch {class destroy} m] $m
    }
} -cleanup {
    interp delete t
} -result {0 {} 1 {invalid command name "class"}}
test oo-0.8 {leak in variable management} -setup {
    oo::class create foo
} -constraints memory -body {
    oo::define foo {
	constructor {} {
	    variable v 0
	}
    }
    leaktest {[foo new] destroy}
} -cleanup {
    foo destroy
} -result 0
test oo-0.9 {various types of presence of the TclOO package} {
    list [lsearch -nocase -all -inline [package names] tcloo] \
	[package present TclOO] [expr {$::oo::patchlevel in [package versions TclOO]}]
} [list TclOO $::oo::patchlevel 1]
test oo-0.9 {various types of presence of the tcl::oo package} {
    list [lsearch -nocase -all -inline [package names] tcl::oo] \
	[package present tcl::oo] [expr {$::oo::patchlevel in [package versions tcl::oo]}]
} [list tcl::oo $::oo::patchlevel 1]

test oo-1.1 {basic test of OO functionality: no classes} {
    set result {}
    lappend result [oo::object create foo]
    lappend result [oo::objdefine foo {
	method bar args {
	    global result

} -result {{} {::oo::Slot ::oo::abstract ::oo::class ::oo::object ::oo::singleton} {::oo::define::filter ::oo::define::mixin ::oo::define::superclass ::oo::define::variable ::oo::objdefine::filter ::oo::objdefine::mixin ::oo::objdefine::variable} {::oo::Slot ::oo::class} {::oo::abstract ::oo::singleton} {} {} {} {} {} ::oo::object ::oo::object ::oo::class ::oo::class ::oo::class}

test oo-2.1 {basic test of OO functionality: constructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
	package require tcl::oo
    }
} -body {
    subinterp eval {
	oo::define oo::object constructor {} {
	    lappend ::result [info level 0]
	}
	lappend result 1

} -result {{in A} ::a 1 {failure in A} {in B ::b} ::b 1 {failure in B}}

test oo-3.1 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as we're
    # modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
	package require tcl::oo
    }
} -body {
    subinterp eval {
	oo::define oo::object destructor {
	    lappend ::result died
	}
	lappend result 1 [oo::object create foo]
	lappend result 2 [rename foo {}]
	oo::define oo::object destructor {}
	return $result
    }
} -cleanup {
    interp delete subinterp
} -result {1 ::foo died 2 {}}
test oo-3.2 {basic test of OO functionality: destructor} -setup {
    # This is a bit complex because it needs to run in a sub-interp as
    # we're modifying the root object class's constructor
    interp create subinterp
    subinterp eval {
	package require TclOO
	package require tcl::oo
    }
} -body {
    subinterp eval {
	oo::define oo::object destructor {
	    lappend ::result died
	}
	lappend result 1 [oo::object create foo]

# This file contains a collection of tests for Tcl's built-in object system.
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
# Copyright (c) 2006-2011 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcl::oo 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {

# This file contains a collection of tests for functionality originally
# sourced from the ooutil package in Tcllib. Sourcing this file into Tcl runs
# the tests and generates output for errors. No output means no errors were
# found.
#
# Copyright (c) 2014-2016 Andreas Kupries
# Copyright (c) 2018 Donal K. Fellows
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require TclOO 1.0.3
package require tcl::oo 1.0.3
if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

test ooUtil-1.1 {TIP 478: classmethod} -setup {
    oo::class create parent

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Do all this in a child interp to avoid garbaging the package list
set i [interp create]
tcltest::loadIntoChildInterpreter $i {*}$argv
catch [list load {} Tcltest $i]
catch [list load {} tcl::test $i]
interp eval $i {
namespace import -force ::tcltest::*
#package forget {*}[package names]
set oldPkgUnknown [package unknown]
package unknown {}
set oldPath $auto_path
set auto_path ""

} -body {
    package require -exact demo 1.2
} -returnCodes error -cleanup {
    package forget demo
} -result {version conflict for package "demo": have 1.2.3, need exactly 1.2}
test package-3.50 {Tcl_PkgRequire procedure, picking best stable version} -constraints testpreferstable -setup {
    interp create child
    load {} Tcltest child
    load {} tcl::test child
    child eval {
    testpreferstable
    package forget t
    set x xxx
    }
} -body {
    child eval {

    } finally {
	interp delete $ip
    }
}

test package-13.0 {package prefer defaults} -body {
    prefer
} -result [expr {[string match {*[ab]*} [package provide Tcl]] ? "latest" : "stable"}]
} -result [expr {[string match {*[ab]*} [package provide tcl]] ? "latest" : "stable"}]
test package-13.1 {package prefer defaults} -body {
    set ::env(TCL_PKG_PREFER_LATEST) stable	;# value not relevant!
    prefer
} -cleanup {
    unset -nocomplain ::env(TCL_PKG_PREFER_LATEST)
} -result latest

    namespace import -force ::tcltest::*
}

namespace eval ::tcl::test::parse {
    namespace import ::tcltest::*

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testparser [llength [info commands testparser]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testevalobjv [llength [info commands testevalobjv]]
testConstraint testevalex [llength [info commands testevalex]]
testConstraint testparsevarname [llength [info commands testparsevarname]]
testConstraint testparsevar [llength [info commands testparsevar]]

    set a
} 1

test parse-19.1 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
    testevalex
} -setup {
    interp create i
    load {} Tcltest i
    load {} tcl::test i
    i eval {proc {} args {}}
    interp recursionlimit i 3
} -body {
    i eval {testevalex {[]}}
} -cleanup {
    interp delete i
}

test parse-19.2 {Bug 1115904: recursion limit in Tcl_EvalEx} -constraints {
    testevalex
} -setup {
    interp create i
    load {} Tcltest i
    load {} tcl::test i
    i eval {proc {} args {}}
    interp recursionlimit i 2
} -body {
    i eval {testevalex {[[]]}}
} -cleanup {
    interp delete i
} -returnCodes error -match glob -result {too many nested*}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Note that the Tcl expression parser (tclCompExpr.c) does not check
# the semantic validity of the expressions it parses. It does not check,
# for example, that a math function actually exists, or that the operands
# of "<<" are integers.

testConstraint testexprparser [llength [info commands testexprparser]]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testwordend [llength [info commands testwordend]]
testConstraint testbytestring [llength [info commands testbytestring]]

# Save the argv value for restoration later
set savedArgv $argv

set x [file join [file dirname [info nameofexecutable]] dltest \
	pkga[info sharedlibextension]]
set dll "[file tail $x]Required"
testConstraint $dll [file exists $x]

if {[testConstraint $dll]} {
    makeFile {
#  This package provides Pkga, which is also provided by a DLL.
package provide Pkga 1.0
#  This package provides pkga, which is also provided by a DLL.
package provide pkga 1.0
proc pkga_neq { x } {
    return [expr {! [pkgq_eq $x]}]
}
} [file join pkg pkga.tcl]
    file copy -force $x $fullPkgPath
}
testConstraint exec [llength [info commands ::exec]]

test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    set cmd [list pkg_mkIndex -lazy $fullPkgPath [file tail $x] pkga.tcl]
    exec [interpreter] << $cmd
    pkgtest::runCreatedIndex {0 {}} -lazy $fullPkgPath pkga[info sharedlibextension] pkga.tcl
} "0 {{Pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
} "0 {{pkga:1.0 {tclPkgSetup {pkga[info sharedlibextension] load {pkga_eq pkga_quote}} {pkga.tcl source pkga_neq}}}}"
test pkgMkIndex-10.2 {package in DLL hidden by -load} [list exec $dll] {
    # Do all [load]ing of shared libraries in another process, so we can
    # delete the file and not get stuck because we're holding a reference to
    # it.
    #
    # This test depends on context from prior test, so repeat it.
    set script \

    namespace import ::tcltest::cleanupTests

    # This is not how [variable] works. See TIP 276.
    #variable ::tcl_platform
    namespace upvar :: tcl_platform tcl_platform

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

testConstraint testCPUID [llength [info commands testcpuid]]
testConstraint testlongsize [llength [info commands testlongsize]]

test platform-1.0 {tcl_platform(engine)} {
  set tcl_platform(engine)

# this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint procbodytest [expr {![catch {package require procbodytest}]}]
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]
testConstraint memory	    [llength [info commands memory]]

catch {namespace delete {*}[namespace children :: test_ns_*]}
catch {rename p ""}
catch {rename {} ""}
catch {unset msg}


catch {rename {a b  c} {}}
catch {unset msg}

catch {rename p ""}
catch {rename t ""}

# Note that the test require that procedures whose body is used to create
# procbody objects must be executed before the procbodytest::proc command is
# procbody objects must be executed before the tcl::procbodytest::proc command is
# executed, so that the Proc struct is populated correctly (CompiledLocals are
# added at compile time).

test proc-4.1 {TclCreateProc, procbody obj} -constraints procbodytest -body {
test proc-4.1 {TclCreateProc, procbody obj} -constraints tcl::test -body {
    proc p x {return "$x:$x"}
    set rv [p P]
    procbodytest::proc t x p
    tcl::procbodytest::proc t x p
    lappend rv [t T]
} -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {P:P T:T}
test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body {
    proc p x {
	set y [string tolower $x]
	return "$x:$y"
    }
    set rv [p P]
    procbodytest::proc t x p
    tcl::procbodytest::proc t x p
    lappend rv [t T]
} -constraints procbodytest -cleanup {
} -constraints tcl::test -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {P:p T:t}
test proc-4.3 {TclCreateProc, procbody obj, too many args} -body {
    proc p x {
	set y [string tolower $x]
	return "$x:$y"
    }
    set rv [p P]
    procbodytest::proc t {x x1 x2} p
    tcl::procbodytest::proc t {x x1 x2} p
    lappend rv [t T]
} -constraints procbodytest -returnCodes error -cleanup {
} -constraints tcl::test -returnCodes error -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {procedure "t": arg list contains 3 entries, precompiled header expects 1}
test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body {
    proc p {x y z} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x x1 z} p
    tcl::procbodytest::proc t {x x1 z} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -constraints tcl::test -returnCodes error -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {procedure "t": formal parameter 1 is inconsistent with precompiled body}
test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
    proc p {x y {z Z}} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y z} p
    tcl::procbodytest::proc t {x y z} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -constraints tcl::test -returnCodes error -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body {
    proc p {x y z} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y {z Z}} p
    tcl::procbodytest::proc t {x y {z Z}} p
    lappend rv [t S T U]
} -returnCodes error -constraints procbodytest -cleanup {
} -returnCodes error -constraints tcl::test -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {procedure "t": formal parameter 2 is inconsistent with precompiled body}
test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -body {
    proc p {x y {z Z}} {
	set v [join [list $x $y $z]]
	set w [string tolower $v]
	return "$v:$w"
    }
    set rv [p P Q R]
    procbodytest::proc t {x y {z ZZ}} p
    tcl::procbodytest::proc t {x y {z ZZ}} p
    lappend rv [t S T U]
} -constraints procbodytest -returnCodes error -cleanup {
} -constraints tcl::test -returnCodes error -cleanup {
    catch {rename p ""}
    catch {rename t ""}
} -result {procedure "t": formal parameter "z" has default value inconsistent with precompiled body}
test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -setup {
    proc getbytes {} {
	set lines [split [memory info] "\n"]
	lindex $lines 3 3
    }
    proc px x {
	set y [string tolower $x]
	return "$x:$y"
    }
    px x
} -constraints {procbodytest memory} -body {
} -constraints {tcl::test memory} -body {
    set end [getbytes]
    for {set i 0} {$i < 5} {incr i} {
	procbodytest::proc tx x px
	tcl::procbodytest::proc tx x px
	set tmp $end
	set end [getbytes]
    }
    set leakedBytes [expr {$end - $tmp}]
} -cleanup {
    rename getbytes {}
    unset -nocomplain end i tmp leakedBytes
} -result 0
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} procbodytest {
    procbodytest::check
test proc-4.9 {[39fed4dae5] Valid Tcl_PkgPresent return} tcl::test {
    tcl::procbodytest::check
} 1

test proc-5.1 {Bytecompiling noop; test for correct argument substitution} -body {
    proc p args {} ; # this will be bytecompiled into t
    proc t {} {
	set res {}
	set a 0

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# All tests require the testregexp command, return if this
# command doesn't exist

::tcltest::testConstraint testregexp [llength [info commands testregexp]]
::tcltest::testConstraint localeRegexp 0

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testdel [llength [info commands testdel]]

# Must eliminate the "unknown" command while the test is running, especially
# if the test is being run in a program with its own special-purpose unknown
# command.
catch {rename unknown unknown.old}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testinterpresolver [llength [info commands testinterpresolver]]

test resolver-1.1 {cmdNameObj sharing vs. cmd resolver: namespace import} -setup {
    testinterpresolver up
    namespace eval ::ns1 {
	proc z {} { return Z }

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Some tests require the testsaveresult command

testConstraint testsaveresult      [llength [info commands testsaveresult]]
testConstraint testsetobjerrorcode [llength [info commands testsetobjerrorcode]]
testConstraint testseterrorcode    [llength [info commands testseterrorcode]]
testConstraint testreturn          [llength [info commands testreturn]]

#
# Copyright (c) 1995-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution of
# this file, and for a DISCLAIMER OF ALL WARRANTIES.

package require Tcl 8.5-

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

foreach i [interp children] {
    interp delete $i

    lsort $listOut
}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)
# testing that nested and statics do what is advertised (we use a
# package - tcl::test - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]

# Tests 5.* test the example files before using them to test safe interpreters.

test safe-zipfs-5.1 {example tclIndex commands, test in parent interpreter; zipfs} -setup {
    set tmpAutoPath $::auto_path
    lappend ::auto_path [file join $ZipMountPoint auto0 auto1] [file join $ZipMountPoint auto0 auto2]
} -body {

}

# Force actual loading of the safe package because we use un-exported (and
# thus un-autoindexed) APIs in this test result arguments:
catch {safe::interpConfigure}

# testing that nested and statics do what is advertised (we use a static
# package - Tcltest - but it might be absent if we're in standard tclsh)
# package - tcl::test - but it might be absent if we're in standard tclsh)

testConstraint TcltestPackage [expr {![catch {package require Tcltest}]}]
testConstraint tcl::test [expr {![catch {package require tcl::test}]}]

test safe-1.1 {safe::interpConfigure syntax} -returnCodes error -body {
    safe::interpConfigure
} -result {no value given for parameter "child" (use -help for full usage) :
    child name () name of the child}
test safe-1.2 {safe::interpCreate syntax} -returnCodes error -body {
    safe::interpCreate -help

         TESTSDIR/auto0/modules/mod2} --\
        {TCLLIB TESTSDIR/auto0/auto1 TESTSDIR/auto0/auto2 TESTSDIR/auto0/modules\
         TESTSDIR/auto0/modules/mod1 TESTSDIR/auto0/modules/mod2} --\
        res0 res1 res2}
# See comments on lsort after test safe-9.20.

catch {teststaticpkg Safepkg1 0 0}
test safe-10.1 {testing statics loading} -constraints TcltestPackage -setup {
test safe-10.1 {testing statics loading} -constraints tcl::test -setup {
    set i [safe::interpCreate]
} -body {
    interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
test safe-10.1.1 {testing statics loading} -constraints tcl::test -setup {
    set i [safe::interpCreate]
} -body {
    catch {interp eval $i {load {} Safepkg1}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure
    invoked from within
"load {} Safepkg1"
    invoked from within
"interp eval $i {load {} Safepkg1}"}
test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackage -body {
test safe-10.2 {testing statics loading / -nostatics} -constraints tcl::test -body {
    set i [safe::interpCreate -nostatics]
    interp eval $i {load {} Safepkg1}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (static package)}
test safe-10.3 {testing nested statics loading / no nested by default} -setup {
    set i [safe::interpCreate]
} -constraints TcltestPackage -body {
} -constraints tcl::test -body {
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {permission denied (nested load)}
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
test safe-10.4 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
    set i [safe::interpCreate -nestedloadok]
    interp eval $i {interp create x; load {} Safepkg1 x}
} -returnCodes error -cleanup {
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure}
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints TcltestPackage -body {
test safe-10.4.1 {testing nested statics loading / -nestedloadok} -constraints tcl::test -body {
    set i [safe::interpCreate -nestedloadok]
    catch {interp eval $i {interp create x; load {} Safepkg1 x}} m o
    dict get $o -errorinfo
} -returnCodes ok -cleanup {
    unset -nocomplain m o
    safe::interpDelete $i
} -result {load of binary library for package Safepkg1 failed: can't use package in a safe interpreter: no Safepkg1_SafeInit procedure

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testset2 [llength [info commands testset2]]

catch {unset x}
catch {unset i}

test set-1.1 {TclCompileSetCmd: missing variable name} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
::tcltest::loadTestedCommands

if {[info exists ::env(TRAVIS_OSX_IMAGE)] && [string match xcode* $::env(TRAVIS_OSX_IMAGE)]} {
    return
}
testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Helper commands to test various optimizations, code paths, and special cases.
proc makeByteArray {s} {binary format a* $s}
proc makeUnicode {s} {lindex [regexp -inline .* $s] 0}
proc makeList {args} {return $args}
proc makeShared {s} {uplevel 1 [list lappend copy $s]; return $s}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testobj [llength [info commands testobj]]
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint tip389 [expr {[string length \U010000] == 2}]
testConstraint nodep [info exists tcl_precision]


# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testbytestring [llength [info commands testbytestring]]

test subst-1.1 {basics} -returnCodes error -body {
    subst
} -result {wrong # args: should be "subst ?-nobackslashes? ?-nocommands? ?-novariables? string"}
test subst-1.2 {basics} -returnCodes error -body {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testnrelevels [llength [info commands testnrelevels]]

#
# The tests that risked blowing the C stack on failure have been removed: we
# can now actually measure using testnrelevels.
#

    namespace import -force ::tcltest::*
}

#  when thread::release is used, -wait is passed in order allow the thread to
#  be fully finalized, which avoids valgrind "still reachable" reports.

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests

# Some tests require the testthread command

testConstraint testthread [expr {[info commands testthread] ne {}}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testcmdtrace [llength [info commands testcmdtrace]]
testConstraint testevalobjv [llength [info commands testevalobjv]]

# Used for constraining memory leak tests
testConstraint memory [llength [info commands memory]]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testchmod [llength [info commands testchmod]]

# These tests really need to be run from a writable directory, which
# it is assumed [temporaryDirectory] is.
set oldcwd [pwd]
cd [temporaryDirectory]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testfindexecutable [llength [info commands testfindexecutable]]

set oldpwd [pwd]
cd [temporaryDirectory]

catch {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Figure out what extension is used for shared libraries on this
# platform.
if {![info exists ext]} {
    set ext [info sharedlibextension]
}

# Tests for loading/unloading in safe interpreters...
interp create -safe child
child eval {
    set pkgua_loaded {}
    set pkgua_detached {}
    set pkgua_unloaded {}
}
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter} \
	[list $dll $loaded] {
    catch {rename pkgb_sub {}}
    load [file join $testDir pkgb$ext] pKgB child
    load [file join $testDir pkgb$ext] pkgb child
    list [child eval pkgb_sub 44 13] [catch {child eval pkgb_unsafe} msg] $msg \
         [catch {pkgb_sub 12 10} msg2] $msg2
} {31 1 {invalid command name "pkgb_unsafe"} 1 {invalid command name "pkgb_sub"}}
test unload-3.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} \
test unload-3.2 {basic loading of unloadable package in a safe interpreter} \
	[list $dll $loaded] {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pKgUA child] \
	    [load [file join $testDir pkgua$ext] pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
test unload-3.3 {unloading of a package that has never been loaded from a safe interpreter} -setup {
    loadIfNotPresent pkga
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir pkga$ext] {} child
} -result {file "*" has never been loaded in this interpreter}
test unload-3.4 {basic unloading of a non-unloadable package from a safe interpreter, with guess for package name} -setup {
    if {[lsearch -index 1 [info loaded child] Pkgb] < 0} {
	load [file join $testDir pkgb$ext] pKgB child
	load [file join $testDir pkgb$ext] pkgb child
    }
} -constraints [list $dll $loaded] -returnCodes error -match glob -body {
    unload [file join $testDir pkgb$ext] {} child
} -result {file "*" cannot be unloaded under a safe interpreter}
test unload-3.5 {basic unloading of an unloadable package from a safe interpreter, with guess for package name} -setup {
    if {[lsearch -index 1 [info loaded child] Pkgua] < 0} {
	load [file join $testDir pkgua$ext] pkgua child

} -constraints [list $dll $loaded] -body {
    list [list $pkgua_loaded $pkgua_detached $pkgua_unloaded] \
	    [load [file join $testDir pkgua$ext]] \
	    [pkgua_eq abc def] [lsort [info commands pkgua_*]] \
	    [list $pkgua_loaded $pkgua_detached $pkgua_unloaded]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-safe interpreter...
test unload-4.2 {basic loading of unloadable package in a safe interpreter, with package name conversion} -setup {
test unload-4.2 {basic loading of unloadable package in a safe interpreter} -setup {
    child eval {
	set pkgua_loaded ""
	set pkgua_detached ""
	set pkgua_unloaded ""
    }
    incr load(C)
} -constraints [list $dll $loaded] -body {
    list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pKgUA child] \
	    [load [file join $testDir pkgua$ext] pkgua child] \
	    [child eval pkgua_eq abc def] \
	    [lsort [child eval info commands pkgua_*]] \
	    [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Load package in child-trusted interpreter...
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter, with package name conversion} -setup {
test unload-4.3 {basic loading of unloadable package in a second trusted interpreter} -setup {
    incr load(T)
} -constraints [list $dll $loaded] -body {
    list [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
	    [load [file join $testDir pkgua$ext] pkguA child-trusted] \
	    [load [file join $testDir pkgua$ext] pkgua child-trusted] \
	    [child-trusted eval pkgua_eq abc def] \
	    [lsort [child-trusted eval info commands pkgua_*]] \
	    [child-trusted eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{{} {} {}} {} 0 {pkgua_eq pkgua_quote} {. {} {}}}
## Unload the package from the main trusted interpreter...
test unload-4.4 {basic unloading of unloadable package from trusted interpreter, with guess for package name} -setup {
    if {!$load(M)} {

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testupvar [llength [info commands testupvar]]

test upvar-1.1 {reading variables with upvar} {
    proc p1 {a b} {set c 22; set d 33; p2}
    proc p2 {} {upvar a x1 b x2 c x3 d x4; set a abc; list $x1 $x2 $x3 $x4 $a}
    p1 foo bar

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint ucs2 [expr {[format %c 0x010000] eq "\uFFFD"}]
testConstraint fullutf [expr {[format %c 0x010000] ne "\uFFFD"}]
testConstraint utf16 [expr {[string length [format %c 0x10000]] == 2}]
testConstraint ucs4 [expr {[testConstraint fullutf]
		&& [string length [format %c 0x10000]] == 1}]
testConstraint ucs2_utf16 [expr {![testConstraint ucs4]}]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint controversialNaN 1
testConstraint testbytestring [llength [info commands testbytestring]]
testConstraint testdstring [llength [info commands testdstring]]
testConstraint testconcatobj [llength [info commands testconcatobj]]
testConstraint testdoubledigits [llength [info commands testdoubledigits]]
testConstraint testprint [llength [info commands testprint]]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testupvar [llength [info commands testupvar]]
testConstraint testgetvarfullname [llength [info commands testgetvarfullname]]
testConstraint testsetnoerr [llength [info commands testsetnoerr]]
testConstraint memory [llength [info commands memory]]
if {[testConstraint memory]} {
    proc getbytes {} {

# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

testConstraint debug [::tcl::pkgconfig get debug]
testConstraint debug [expr {"debug" in [split [package provide Tcl] .]}]
testConstraint dde 0
if {[testConstraint win]} {
    if {![catch {
	    ::tcltest::loadTestedCommands
	    set ::ddever [package require dde 1.4.3]
	    set ::ddelib [lindex [package ifneeded dde $::ddever] 1]}]} {
	testConstraint dde 1

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

# Initialise the test constraints

testConstraint winVista 0
testConstraint winXP 0
testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint testfile       [llength [info commands testfile]]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testvolumetype [llength [info commands testvolumetype]]
testConstraint notNTFS 0

if {[testConstraint testvolumetype]} {
    testConstraint notNTFS [expr {[testvolumetype] eq "NTFS"}]
}

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testeventloop [expr {[info commands testeventloop] != {}}]

# There is no explicit test for InitNotifier or NotifierExitHandler

test winNotify-1.1 {Tcl_SetTimer: positive timeout} {win} {
    set done 0

    package require tcltest 2.5
    namespace import -force ::tcltest::*
}
unset -nocomplain path

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

set org_pwd [pwd]
set bindir [file join $org_pwd [file dirname [info nameofexecutable]]]
set cat32 [file join $bindir cat32.exe]

testConstraint notWine [expr {$::tcl_platform(platform) ne "windows" || ![info exists ::env(TRAVIS_OS_NAME)] || ![string match linux $::env(TRAVIS_OS_NAME)]}]

    set result ""
    vwait x
    list $result $x [contents $path(stderr)]
} "{$big} 1 stderr32"
test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "load $::tcltestlib tcl::test"
    puts $f "testexcept float_underflow"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGFPE}
test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "load $::tcltestlib tcl::test"
    puts $f "testexcept access_violation"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGSEGV}
test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "load $::tcltestlib tcl::test"
    puts $f "testexcept illegal_instruction"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGILL}
test winpipe-4.5 {Tcl_WaitPid: return of exception codes, SIGINT} {win exec testexcept notWine} {
    set f [open "|[list [interpreter]]" w+]
    set pid [pid $f]
    puts $f "load $::tcltestlib Tcltest"
    puts $f "load $::tcltestlib tcl::test"
    puts $f "testexcept ctrl+c"
    set status [catch {close $f}]
    list $status [expr {$pid == [lindex $::errorCode 1]}] [lindex $::errorCode 2]
} {1 1 SIGINT}

set path(nothing) [makeFile {} nothing]
close [open $path(nothing) w]

if {"::tcltest" ni [namespace children]} {
    package require tcltest 2.5
    namespace import -force ::tcltest::*
}

::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]

testConstraint testwinclock [llength [info commands testwinclock]]
testConstraint knownMsvcBug [expr {![info exists ::env(TRAVIS_OS_NAME)] || ![string match windows $::env(TRAVIS_OS_NAME)]}]

# The next two tests will crash on Windows if the check for negative
# clock values is not done properly.

set ziproot [zipfs root]
set CWD [pwd]
set tmpdir  [file join $CWD tmp]
file mkdir $tmpdir

test zipfs-0.0 {zipfs basics} -constraints zipfs -body {
    package require zipfs
    package require tcl::zipfs
} -result {2.0}
test zipfs-0.1 {zipfs basics} -constraints zipfs -body {
    expr {${ziproot} in [file volumes]}
} -result 1

if {![string match ${ziproot}* $tcl_library]} {
    ###

test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
    zlib ? {}
} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
test zlib-1.3 {zlib basics} -constraints zlib -body {
    zlib::pkgconfig list
} -result zlibVersion
test zlib-1.4 {zlib basics} -constraints zlib -body {
    package present zlib
    package present tcl::zlib
} -result 2.0.1

test zlib-2.1 {zlib compress/decompress} zlib {
    zlib decompress [zlib compress abcdefghijklm]
} abcdefghijklm

test zlib-3.1 {zlib deflate/inflate} zlib {

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkga", "1.0");
    code = Tcl_PkgProvide(interp, "pkga", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkga_eq", Pkga_EqObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkga_quote", Pkga_QuoteObjCmd, NULL,
	    NULL);
    return TCL_OK;

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    code = Tcl_PkgProvide(interp, "pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgb_unsafe", Pkgb_UnsafeObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgb_demo", Pkgb_DemoObjCmd, NULL, NULL);
    return TCL_OK;

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgb", "2.3");
    code = Tcl_PkgProvide(interp, "pkgb", "2.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgb_sub", Pkgb_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
    code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgc_unsafe", Pkgc_UnsafeObjCmd, NULL,
	    NULL);
    return TCL_OK;

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgc", "1.7.2");
    code = Tcl_PkgProvide(interp, "pkgc", "1.7.2");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgc_sub", Pkgc_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
    code = Tcl_PkgProvide(interp, "pkgd", "7.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
    Tcl_CreateObjCommand(interp, "pkgd_unsafe", Pkgd_UnsafeObjCmd, NULL,
	    NULL);
    return TCL_OK;

				 * made available. */
{
    int code;

    if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
	return TCL_ERROR;
    }
    code = Tcl_PkgProvide(interp, "Pkgd", "7.3");
    code = Tcl_PkgProvide(interp, "pkgd", "7.3");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgd_sub", Pkgd_SubObjCmd, NULL, NULL);
    return TCL_OK;
}

     * AIX), this code doesn't even compile without using
     * stubs, but on UNIX ELF systems, the problem is
     * less visible.
     */

    tclOOStubsPtr = &stubsCopy;

    code = Tcl_PkgProvide(interp, "Pkgooa", "1.0");
    code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
    if (code != TCL_OK) {
	return code;
    }
    Tcl_CreateObjCommand(interp, "pkgooa_stubsok", Pkgooa_StubsOKObjCmd, NULL, NULL);
    return TCL_OK;
}

    /*
     * Initialise our Hash table, where we store the registered command tokens
     * for each interpreter.
     */

    PkguaInitTokensHashTable();

    code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
    code = Tcl_PkgProvide(interp, "pkgua", "1.0");
    if (code != TCL_OK) {
	return code;
    }

    Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);

    cmdTokens = PkguaInterpToTokens(interp);

    }
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
    Tcl_StaticPackage(interp, "tcl::test", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_TEST */

    /*
     * Call the init procedures for included packages. Each call should look
     * like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {

REG_LIB_FILE		= @LIBPREFIX@tclreg$(REGVER)${DLLSUFFIX}${LIBSUFFIX}
TEST_DLL_FILE		= tcltest$(VER)${DLLSUFFIX}
TEST_EXE_FILE		= tcltest${EXESUFFIX}
TEST_LIB_FILE		= @LIBPREFIX@tcltest$(VER)${DLLSUFFIX}${LIBSUFFIX}
TEST_LOAD_PRMS		= lappend ::auto_path {$(ROOT_DIR_WIN_NATIVE)/tests};\
			  package ifneeded dde 1.4.3 [list load [file normalize ${DDE_DLL_FILE}] dde];\
			  package ifneeded registry 1.3.5 [list load [file normalize ${REG_DLL_FILE}] registry]
TEST_LOAD_FACILITIES	= package ifneeded Tcltest ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] Tcltest];\
TEST_LOAD_FACILITIES	= package ifneeded tcl::test ${VERSION}@TCL_PATCH_LEVEL@ [list load [file normalize ${TEST_DLL_FILE}] tcl::test];\
			  $(TEST_LOAD_PRMS)
ZLIB_DLL_FILE		= zlib1.dll
TOMMATH_DLL_FILE		= libtommath.dll

SHARED_LIBRARIES 	= $(TCL_DLL_FILE) @ZLIB_DLL_FILE@ @TOMMATH_DLL_FILE@
STATIC_LIBRARIES	= $(TCL_LIB_FILE)

    Tcl_StaticPackage(interp, "dde", Dde_Init, Dde_SafeInit);
#endif

#ifdef TCL_TEST
    if (Tcltest_Init(interp) == TCL_ERROR) {
	return TCL_ERROR;
    }
    Tcl_StaticPackage(interp, "Tcltest", Tcltest_Init, Tcltest_SafeInit);
    Tcl_StaticPackage(interp, "tcl::test", Tcltest_Init, Tcltest_SafeInit);
#endif /* TCL_TEST */

    /*
     * Call the init procedures for included packages. Each call should look
     * like this:
     *
     * if (Mod_Init(interp) == TCL_ERROR) {