Compare commits

...
100 changed files with 332 additions and 315 deletions
+1 -2
View File
@@ -22,8 +22,7 @@ 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
upper-case, all others lower-case).
Name of the package.
.AP Tcl_PackageInitProc *initProc in
Procedure to invoke to incorporate this package into a trusted
interpreter.
+1 -1
View File
@@ -14,7 +14,7 @@
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
+1
View File
@@ -1175,6 +1175,7 @@ Tcl_CreateInterp(void)
*/
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)));
+39 -33
View File
@@ -226,14 +226,8 @@ Tcl_LoadObjCmd(
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 = 1;
} else {
namesMatch = 0;
}
namesMatch = (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&pkgName)) == 0);
}
TclDStringClear(&pkgName);
@@ -359,27 +353,29 @@ Tcl_LoadObjCmd(
}
/*
* 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
@@ -433,6 +429,22 @@ Tcl_LoadObjCmd(
*/
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");
}
/*
@@ -444,7 +456,7 @@ Tcl_LoadObjCmd(
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;
@@ -454,8 +466,8 @@ Tcl_LoadObjCmd(
} 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;
@@ -663,14 +675,8 @@ Tcl_UnloadObjCmd(
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 = 1;
} else {
namesMatch = 0;
}
namesMatch = (strcmp(Tcl_DStringValue(&tmp),
Tcl_DStringValue(&pkgName)) == 0);
}
TclDStringClear(&pkgName);
+8 -1
View File
@@ -138,7 +138,10 @@ static const Tcl_MethodType classConstructor = {
*/
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" */
@@ -257,7 +260,11 @@ TclOOInit(
return TCL_ERROR;
}
return Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
#ifndef TCL_NO_DEPRECATED
Tcl_PkgProvideEx(interp, "TclOO", TCLOO_PATCHLEVEL,
(void *) &tclOOStubs);
#endif
return Tcl_PkgProvideEx(interp, "tcl::oo", TCLOO_PATCHLEVEL,
(void *) &tclOOStubs);
}
+7 -2
View File
@@ -35,14 +35,19 @@ TclOOInitializeStubs(
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) {
return NULL;
packageName = "TclOO";
actualVersion = tclStubsPtr->tcl_PkgRequireEx(interp,
packageName, version, exact, &stubsPtr);
if (actualVersion == NULL) {
return NULL;
}
}
if (stubsPtr == NULL) {
errMsg = "missing stub table pointer";
+1 -1
View File
@@ -460,7 +460,7 @@ Tcltest_Init(
}
/* 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;
}
+4 -4
View File
@@ -20,7 +20,7 @@
* name and version of this package
*/
static const char packageName[] = "procbodytest";
static const char packageName[] = "tcl::procbodytest";
static const char packageVersion[] = "1.1";
/*
@@ -75,7 +75,7 @@ static const CmdTable safeCommands[] = {
*
* Procbodytest_Init --
*
* This function initializes the "procbodytest" package.
* This function initializes the "tcl::procbodytest" package.
*
* Results:
* A standard Tcl result.
@@ -99,7 +99,7 @@ Procbodytest_Init(
*
* Procbodytest_SafeInit --
*
* This function initializes the "procbodytest" package.
* This function initializes the "tcl::procbodytest" package.
*
* Results:
* A standard Tcl result.
@@ -315,7 +315,7 @@ ProcBodyTestProcObjCmd(
* 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.
*
+1 -1
View File
@@ -4771,7 +4771,7 @@ TclZipfs_Init(
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 */
+4 -1
View File
@@ -3957,7 +3957,10 @@ TclZlibInit(
* Formally provide the package as a Tcl built-in.
*/
return Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
#ifndef TCL_NO_DEPRECATED
Tcl_PkgProvide(interp, "zlib", TCL_ZLIB_VERSION);
#endif
return Tcl_PkgProvide(interp, "tcl::zlib", TCL_ZLIB_VERSION);
}
/*
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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)]}]
+1 -1
View File
@@ -21,7 +21,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+4 -4
View File
@@ -36,8 +36,8 @@ namespace eval ::tcl::test::io {
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
@@ -7493,7 +7493,7 @@ test chan-io-59.1 {Thread reference of channels} {testmainthread testchannel} {
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
@@ -7576,7 +7576,7 @@ test chan-io-70.1 {Transfer channel} -setup {
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}]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
::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]]
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
::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]
+1 -1
View File
@@ -14,7 +14,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
::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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]} {
+1 -1
View File
@@ -19,7 +19,7 @@ namespace eval ::tcl::test::encoding {
catch {
::tcltest::loadTestedCommands
package require -exact Tcltest [info patchlevel]
package require -exact tcl::test [info patchlevel]
}
proc toutf {args} {
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
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
+7 -7
View File
@@ -14,8 +14,8 @@ 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]
}
@@ -436,7 +436,7 @@ 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
@@ -450,7 +450,7 @@ 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"
@@ -464,7 +464,7 @@ 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"
@@ -478,7 +478,7 @@ 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"
@@ -492,7 +492,7 @@ 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
+1 -1
View File
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
}
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.
+5 -5
View File
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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 ""}
@@ -683,12 +683,12 @@ test execute-6.11 {Tcl_ExprObj: exprcode interp validation} -setup {
} -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 {
@@ -985,7 +985,7 @@ 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 }
@@ -1018,7 +1018,7 @@ test execute-8.7 {Compile epoch bump in global level (bug [fa6bf38d07]), excepti
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 }
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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.
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
cd [temporaryDirectory]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
::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]]
+2 -2
View File
@@ -25,7 +25,7 @@ namespace eval ::tcl::test::fileSystem {
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]
@@ -33,7 +33,7 @@ catch {
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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -14,7 +14,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -20,7 +20,7 @@ if {{::tcltest} ni [namespace children]} {
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",
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+4 -4
View File
@@ -31,8 +31,8 @@ namespace eval ::tcl::test::io {
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
@@ -8385,7 +8385,7 @@ 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
@@ -8477,7 +8477,7 @@ test io-70.1 {Transfer channel} {testchannel thread} {
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}]
+11 -11
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
package require tcltests
@@ -2085,8 +2085,8 @@ test iocmd-32.0 {origin interpreter of moved channel gone} -match glob -body {
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
@@ -2123,8 +2123,8 @@ test iocmd-32.1 {origin interpreter of moved channel destroyed during access} -m
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]
@@ -2194,7 +2194,7 @@ 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
@@ -2833,7 +2833,7 @@ test iocmd.tf-24.17.bug3522560 {postevent for transfered channel} \
return
}
LOG THREAD-STARTED
load {} Tcltest
load {} tcl::test
proc bgerror s {
LOG BGERROR:$s
}
@@ -3790,10 +3790,10 @@ 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
@@ -3840,9 +3840,9 @@ test iocmd.tf-32.1 {origin thread of moved channel destroyed during access} -mat
#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
+11 -11
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
@@ -1163,8 +1163,8 @@ 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
@@ -1206,8 +1206,8 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
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]
@@ -1246,7 +1246,7 @@ test iortrans-11.1 {origin interpreter of moved transform destroyed during acces
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]
@@ -1285,7 +1285,7 @@ test iortrans-11.2 {delete interp of reflected transform} -setup {
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
@@ -2002,9 +2002,9 @@ test iortrans.tf-8.2 {close flushes write buffers, writes data} -setup {
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
@@ -2046,9 +2046,9 @@ 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
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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::*
+1 -1
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+2 -2
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
@@ -28,7 +28,7 @@ foreach i {int real bool string} {
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 ::
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+36 -36
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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.
@@ -78,7 +78,7 @@ test load-2.1 {basic loading, with guess for package name} \
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"}}
@@ -127,8 +127,8 @@ test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
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\""
load [file join $testDir pkga$ext] Pkgb
} -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}
@@ -139,7 +139,7 @@ test load-5.1 {file name not specified and no static package: pick default} -set
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.
@@ -152,89 +152,89 @@ test load-6.1 {errors loading file} [list $dll $loaded] {
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 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
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
list [catch {load simplefs:/pkgd$ext PKGD} msg] $msg
} -result {0 {}} -cleanup {
testsimplefilesystem 0
cd $dir
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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"
+40 -42
View File
@@ -11,12 +11,10 @@ namespace eval ::tcl::test::main {
# Is [exec] defined?
testConstraint exec [llength [info commands exec]]
# Is the Tcltest 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-]}]
# Is the tcl::test package loaded?
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} {
@@ -192,7 +190,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-2.1 {
Tcl_Main: appInitProc returns error
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
makeFile {puts "In script"} script
} -body {
@@ -208,7 +206,7 @@ namespace eval ::tcl::test::main {
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]
@@ -221,7 +219,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-2.3 {
Tcl_Main: appInitProc deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
makeFile {puts "In script"} script
} -body {
@@ -237,7 +235,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-2.4 {
Tcl_Main: appInitProc deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {puts "In script"} \
-appinitprocdeleteinterp >& result
@@ -251,7 +249,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-2.5 {
Tcl_Main: appInitProc closes stderr
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {puts "In script"} \
-appinitprocclosestderr >& result
@@ -336,7 +334,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-3.5 {
Tcl_Main: startup script sets main loop
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
makeFile {
rename exit _exit
@@ -364,7 +362,7 @@ namespace eval ::tcl::test::main {
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
@@ -393,7 +391,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-3.7 {
Tcl_Main: startup script deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
makeFile {
rename exit _exit
@@ -417,7 +415,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-3.8 {
Tcl_Main: startup script deletes interp and sets mainloop
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
makeFile {
testsetmainloop
@@ -461,7 +459,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-4.1 {
Tcl_Main: rcFile evaluation deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
set rc [makeFile {testinterpdelete {}} rc]
} -body {
@@ -478,7 +476,7 @@ namespace eval ::tcl::test::main {
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 {
@@ -495,7 +493,7 @@ namespace eval ::tcl::test::main {
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
@@ -523,7 +521,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-4.4 {
Tcl_Main: rcFile evaluation sets main loop
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
set rc [makeFile {
testsetmainloop
@@ -550,7 +548,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-4.5 {
Tcl_Main: Bug 1481986
} -constraints {
exec Tcltest
exec tcl::test
} -setup {
set rc [makeFile {
testsetmainloop
@@ -698,7 +696,7 @@ namespace eval ::tcl::test::main {
Tcl_Main: interactive mode: close stdin
-> main loop & [exit] & exit handlers
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
rename exit _exit
@@ -722,7 +720,7 @@ namespace eval ::tcl::test::main {
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
@@ -745,7 +743,7 @@ namespace eval ::tcl::test::main {
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}
@@ -766,7 +764,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-5.11 {
Tcl_Main: EOF in interactive main loop
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
rename exit _exit
@@ -788,7 +786,7 @@ namespace eval ::tcl::test::main {
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
@@ -841,7 +839,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-6.2 {
Tcl_Main: prompt deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
set tcl_prompt1 {testinterpdelete {}}
@@ -893,7 +891,7 @@ namespace eval ::tcl::test::main {
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
@@ -943,7 +941,7 @@ namespace eval ::tcl::test::main {
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 {}
@@ -959,7 +957,7 @@ namespace eval ::tcl::test::main {
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 {}
@@ -979,7 +977,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.1 {
StdinProc: handles non-blocking stdin
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -996,7 +994,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.2 {
StdinProc: handles stdin EOF
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1018,7 +1016,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.3 {
StdinProc: handles interactive stdin EOF
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1039,7 +1037,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.4 {
StdinProc: handles stdin close
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1062,7 +1060,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.5 {
StdinProc: handles interactive stdin close
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1086,7 +1084,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.6 {
StdinProc: handles event loop re-entry
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1105,7 +1103,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.7 {
StdinProc: handling of errors
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1122,7 +1120,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.8 {
StdinProc: handling of errors, closed stderr
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1140,7 +1138,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.9 {
StdinProc: interactive output
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1156,7 +1154,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.10 {
StdinProc: interactive output, closed stdout
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1174,7 +1172,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.11 {
StdinProc: prompt deletes interp
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1190,7 +1188,7 @@ namespace eval ::tcl::test::main {
test Tcl_Main-8.12 {
StdinProc: prompt closes stdin
} -constraints {
exec Tcltest
exec tcl::test
} -body {
exec [interpreter] << {
testsetmainloop
@@ -1209,7 +1207,7 @@ namespace eval ::tcl::test::main {
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]
+1 -1
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
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
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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}]
+12 -12
View File
@@ -7,7 +7,7 @@
# 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::*
@@ -38,14 +38,14 @@ if {[testConstraint memory]} {
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
@@ -79,7 +79,7 @@ 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
}
@@ -90,7 +90,7 @@ 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
}
@@ -109,10 +109,10 @@ test oo-0.8 {leak in variable management} -setup {
} -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 {}
@@ -383,7 +383,7 @@ test oo-2.1 {basic test of OO functionality: constructor} -setup {
# we're modifying the root object class's constructor
interp create subinterp
subinterp eval {
package require TclOO
package require tcl::oo
}
} -body {
subinterp eval {
@@ -514,7 +514,7 @@ test oo-3.1 {basic test of OO functionality: destructor} -setup {
# modifying the root object class's constructor
interp create subinterp
subinterp eval {
package require TclOO
package require tcl::oo
}
} -body {
subinterp eval {
@@ -534,7 +534,7 @@ test oo-3.2 {basic test of OO functionality: destructor} -setup {
# we're modifying the root object class's constructor
interp create subinterp
subinterp eval {
package require TclOO
package require tcl::oo
}
} -body {
subinterp eval {
+1 -1
View File
@@ -7,7 +7,7 @@
# 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::*
+1 -1
View File
@@ -9,7 +9,7 @@
# 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::*
+4 -4
View File
@@ -18,12 +18,12 @@ if {"::tcltest" ni [namespace children]} {
}
::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]
@@ -577,7 +577,7 @@ test package-3.44 {Tcl_PkgRequire: exact version matching (1578344)} -setup {
} -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
@@ -1340,7 +1340,7 @@ proc prefer {args} {
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
+3 -3
View File
@@ -17,7 +17,7 @@ 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]]
@@ -1051,7 +1051,7 @@ 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 {
@@ -1064,7 +1064,7 @@ 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 {
+1 -1
View File
@@ -14,7 +14,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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,
+1 -1
View File
@@ -19,7 +19,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+3 -3
View File
@@ -559,8 +559,8 @@ 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]}]
}
@@ -576,7 +576,7 @@ test pkgMkIndex-10.1 {package in DLL and script} [list exec $dll] {
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
+1 -1
View File
@@ -21,7 +21,7 @@ namespace eval ::tcl::test::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]]
+20 -20
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
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_*]}
@@ -210,14 +210,14 @@ 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 ""}
@@ -229,9 +229,9 @@ test proc-4.2 {TclCreateProc, procbody obj, use compiled locals} -body {
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}
@@ -241,9 +241,9 @@ test proc-4.3 {TclCreateProc, procbody obj, too many args} -body {
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}
@@ -254,9 +254,9 @@ test proc-4.4 {TclCreateProc, procbody obj, inconsistent arg name} -body {
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}
@@ -267,9 +267,9 @@ test proc-4.5 {TclCreateProc, procbody obj, inconsistent arg default type} -body
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}
@@ -280,9 +280,9 @@ test proc-4.6 {TclCreateProc, procbody obj, inconsistent arg default type} -body
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}
@@ -293,9 +293,9 @@ test proc-4.7 {TclCreateProc, procbody obj, inconsistent arg default value} -bod
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}
@@ -309,10 +309,10 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
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]
}
@@ -321,8 +321,8 @@ test proc-4.8 {TclCreateProc, procbody obj, no leak on multiple iterations} -set
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 {
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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
+3 -5
View File
@@ -13,8 +13,6 @@
# 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::*
@@ -53,10 +51,10 @@ proc mapAndSortList {map listIn} {
# 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.
+8 -8
View File
@@ -54,9 +54,9 @@ proc mapAndSortList {map listIn} {
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
@@ -1158,14 +1158,14 @@ test safe-9.24 {interpConfigure change the access path; check module loading; st
# 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
@@ -1178,7 +1178,7 @@ test safe-10.1.1 {testing statics loading} -constraints TcltestPackage -setup {
"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 {
@@ -1186,18 +1186,18 @@ test safe-10.2 {testing statics loading / -nostatics} -constraints TcltestPackag
} -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
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -66,7 +66,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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)]} {
+1 -1
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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}
+1 -1
View File
@@ -18,7 +18,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
# 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
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -15,7 +15,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+10 -10
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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.
@@ -135,17 +135,17 @@ child eval {
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}]
@@ -157,7 +157,7 @@ test unload-3.3 {unloading of a package that has never been loaded from a safe i
} -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
@@ -218,7 +218,7 @@ test unload-4.1 {loading of unloadable package in trusted interpreter, with gues
[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 ""
@@ -227,17 +227,17 @@ test unload-4.2 {basic loading of unloadable package in a safe interpreter, with
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}]
+1 -1
View File
@@ -17,7 +17,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -14,7 +14,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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"}]
+1 -1
View File
@@ -13,7 +13,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -20,7 +20,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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]]
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::tcltest::loadTestedCommands
catch [list package require -exact Tcltest [info patchlevel]]
catch [list package require -exact tcl::test [info patchlevel]]
# Initialise the test constraints
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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
+1 -1
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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] != {}}]
+6 -6
View File
@@ -20,8 +20,8 @@ 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]
@@ -203,7 +203,7 @@ test winpipe-4.1 {Tcl_WaitPid} {win exec cat32} {
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]
@@ -211,7 +211,7 @@ test winpipe-4.2 {Tcl_WaitPid: return of exception codes, SIGFPE} {win exec test
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]
@@ -219,7 +219,7 @@ test winpipe-4.3 {Tcl_WaitPid: return of exception codes, SIGSEGV} {win exec tes
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]
@@ -227,7 +227,7 @@ test winpipe-4.4 {Tcl_WaitPid: return of exception codes, SIGILL} {win exec test
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
View File
@@ -16,7 +16,7 @@ if {"::tcltest" ni [namespace children]} {
}
::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)]}]
+1 -1
View File
@@ -31,7 +31,7 @@ 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]}
+1 -1
View File
@@ -34,7 +34,7 @@ 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 {
+1 -1
View File
@@ -129,7 +129,7 @@ Pkga_Init(
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;
}
+1 -1
View File
@@ -1,7 +1,7 @@
/*
* pkgb.c --
*
* This file contains a simple Tcl package "pkgb" that is intended for
* This file contains a simple Tcl package "Pkgb" that is intended for
* testing the Tcl dynamic loading facilities. It can be used in both
* safe and unsafe interpreters.
*
+2 -2
View File
@@ -121,7 +121,7 @@ Pkgc_Init(
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;
}
@@ -158,7 +158,7 @@ Pkgc_SafeInit(
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;
}
+3 -3
View File
@@ -1,7 +1,7 @@
/*
* pkgd.c --
*
* This file contains a simple Tcl package "pkgd" that is intended for
* This file contains a simple Tcl package "PKGD" that is intended for
* testing the Tcl dynamic loading facilities. It can be used in both
* safe and unsafe interpreters.
*
@@ -121,7 +121,7 @@ Pkgd_Init(
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;
}
@@ -158,7 +158,7 @@ Pkgd_SafeInit(
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;
}
+1 -1
View File
@@ -138,7 +138,7 @@ Pkgooa_Init(
tclOOStubsPtr = &stubsCopy;
code = Tcl_PkgProvide(interp, "Pkgooa", "1.0");
code = Tcl_PkgProvide(interp, "pkgooa", "1.0");
if (code != TCL_OK) {
return code;
}
+1 -1
View File
@@ -213,7 +213,7 @@ Pkgua_Init(
PkguaInitTokensHashTable();
code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
code = Tcl_PkgProvide(interp, "pkgua", "1.0");
if (code != TCL_OK) {
return code;
}
+1 -1
View File
@@ -124,7 +124,7 @@ Tcl_AppInit(
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 */
/*
+1 -1
View File
@@ -158,7 +158,7 @@ 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
+1 -1
View File
@@ -180,7 +180,7 @@ Tcl_AppInit(
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 */
/*