From d9bbe48c46c61ced3aff0579f622fb0a180e19fa Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 17 May 2021 21:29:25 +0000
Subject: Additional test for [688fcc7082fa99a4].
---
tests/namespace.test | 32 ++++++++++++++++++++++++++++++++
1 file changed, 32 insertions(+)
diff --git a/tests/namespace.test b/tests/namespace.test
index 8209cf3..ed52102 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3340,6 +3340,38 @@ test namespace-56.5 {Bug 8b9854c3d8} -setup {
} -result 1
+test namespace-56.6 {
+ Namespace deletion traces on both the original routine and the imported
+ routine should run without any memory error under a debug build.
+} -body {
+ variable res 0
+
+ proc ondelete {old new op} {
+ $old
+ }
+
+ namespace eval ns1 {} {
+ namespace export *
+ proc p1 {} {
+ namespace upvar [namespace parent] res res
+ incr res
+ }
+ trace add command p1 delete ondelete
+ }
+
+ namespace eval ns2 {} {
+ namespace import ::ns1::p1
+ trace add command p1 delete ondelete
+ }
+
+ namespace delete ns1
+ namespace delete ns2
+ return $res
+} -cleanup {
+ unset res
+ rename ondelete {}
+} -result 2
+
test namespace-57.0 {
an imported alias should be usable in the deletion trace for the alias
--
cgit v0.12
From a8516aa6294e6d1634e5485f15f6c9d11c7ff707 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 17 May 2021 21:30:57 +0000
Subject: Fix for [688fcc7082fa99a4], trace on imported alias deletes alias and
then calls import and triggers memory error.
---
generic/tclBasic.c | 27 +++++++++++++--------------
1 file changed, 13 insertions(+), 14 deletions(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index 2f1819f..c73af35 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3209,6 +3209,19 @@ Tcl_DeleteCommandFromToken(
iPtr->compileEpoch++;
}
+ /*
+ * Delete any imports of this routine elsewhere before calling deleteProc
+ * to that traces on the imports don't reference deallocated storage.
+ */
+ if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
+ for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
+ refPtr = nextRefPtr) {
+ nextRefPtr = refPtr->nextPtr;
+ importCmd = (Tcl_Command) refPtr->importedCmdPtr;
+ Tcl_DeleteCommandFromToken(interp, importCmd);
+ }
+ }
+
if (cmdPtr->deleteProc != NULL) {
/*
* Delete the command's client data. If this was an imported command
@@ -3229,20 +3242,6 @@ Tcl_DeleteCommandFromToken(
}
/*
- * If this command was imported into other namespaces, then imported
- * commands were created that refer back to this command. Delete these
- * imported commands now.
- */
- if (!(cmdPtr->flags & CMD_REDEF_IN_PROGRESS)) {
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
- }
- }
-
- /*
* Don't use hPtr to delete the hash entry here, because it's possible
* that the deletion callback renamed the command. Instead, use
* cmdPtr->hptr, and make sure that no-one else has already deleted the
--
cgit v0.12
From 5bdefd0c25145655f82ef005e51bf77df5fafbe6 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Mon, 17 May 2021 21:34:25 +0000
Subject: Remove unnecessary refCount decrement.
---
generic/tclBasic.c | 1 -
1 file changed, 1 deletion(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c73af35..deca238 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3389,7 +3389,6 @@ CallCommandTraces(
*/
cmdPtr->flags &= ~CMD_TRACE_ACTIVE;
- cmdPtr->refCount--;
iPtr->activeCmdTracePtr = active.nextPtr;
Tcl_Release(iPtr);
return result;
--
cgit v0.12
From d3e0d5789c2788a38bfd2d670a74b8e08b2e76d5 Mon Sep 17 00:00:00 2001
From: pooryorick <com.digitalsmarties@pooryorick.com>
Date: Tue, 18 May 2021 10:24:17 +0000
Subject: Remove the refCount increment that accompanied the decrement removed
in the last commit.
---
generic/tclBasic.c | 1 -
1 file changed, 1 deletion(-)
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index deca238..df86f8c 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -3331,7 +3331,6 @@ CallCommandTraces(
}
}
cmdPtr->flags |= CMD_TRACE_ACTIVE;
- cmdPtr->refCount++;
result = NULL;
active.nextPtr = iPtr->activeCmdTracePtr;
--
cgit v0.12
From 39ef112133e88eb09bd7a2a6cdcf970659d5db09 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Tue, 18 May 2021 12:02:55 +0000
Subject: Make Pkgua package thread-safe and properly clean up everything when
being unloaded. Based on pyk-tclUnload branch, but extended for thread-safety
(Thanks!)
---
tests/namespace.test | 2 +-
unix/dltest/pkgua.c | 53 ++++++++++++++++++++++++++++++++--------------------
2 files changed, 34 insertions(+), 21 deletions(-)
diff --git a/tests/namespace.test b/tests/namespace.test
index ed52102..e585504 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -3344,7 +3344,7 @@ test namespace-56.6 {
Namespace deletion traces on both the original routine and the imported
routine should run without any memory error under a debug build.
} -body {
- variable res 0
+ variable res 0
proc ondelete {old new op} {
$old
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 9dde4fa..07556d1 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -22,6 +22,7 @@ static int PkguaEqObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
static int PkguaQuoteObjCmd(ClientData clientData,
Tcl_Interp *interp, int objc, Tcl_Obj *const objv[]);
+static void CommandDeleted(ClientData clientData);
/*
* In the following hash table we are going to store a struct that holds all
@@ -31,23 +32,32 @@ static int PkguaQuoteObjCmd(ClientData clientData,
* need to keep the various command tokens we have registered, as they are the
* only safe way to unregister our registered commands, even if they have been
* renamed.
- *
- * Note that this code is utterly single-threaded.
*/
-static Tcl_HashTable interpTokenMap;
-static int interpTokenMapInitialised = 0;
+typedef struct ThreadSpecificData {
+ int interpTokenMapInitialised;
+ Tcl_HashTable interpTokenMap;
+} ThreadSpecificData;
+static Tcl_ThreadDataKey dataKey;
#define MAX_REGISTERED_COMMANDS 2
+static void
+CommandDeleted(ClientData clientData)
+{
+ Tcl_Command *cmdToken = (Tcl_Command *)clientData;
+ *cmdToken = NULL;
+}
static void
PkguaInitTokensHashTable(void)
{
- if (interpTokenMapInitialised) {
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
+
+ if (tsdPtr->interpTokenMapInitialised) {
return;
}
- Tcl_InitHashTable(&interpTokenMap, TCL_ONE_WORD_KEYS);
- interpTokenMapInitialised = 1;
+ Tcl_InitHashTable(&tsdPtr->interpTokenMap, TCL_ONE_WORD_KEYS);
+ tsdPtr->interpTokenMapInitialised = 1;
}
static void
@@ -55,12 +65,13 @@ PkguaFreeTokensHashTable(void)
{
Tcl_HashSearch search;
Tcl_HashEntry *entryPtr;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
- for (entryPtr = Tcl_FirstHashEntry(&interpTokenMap, &search);
+ for (entryPtr = Tcl_FirstHashEntry(&tsdPtr->interpTokenMap, &search);
entryPtr != NULL; entryPtr = Tcl_NextHashEntry(&search)) {
Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
}
- interpTokenMapInitialised = 0;
+ tsdPtr->interpTokenMapInitialised = 0;
}
static Tcl_Command *
@@ -69,13 +80,14 @@ PkguaInterpToTokens(
{
int newEntry;
Tcl_Command *cmdTokens;
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr =
- Tcl_CreateHashEntry(&interpTokenMap, (char *) interp, &newEntry);
+ Tcl_CreateHashEntry(&tsdPtr->interpTokenMap, (char *) interp, &newEntry);
if (newEntry) {
cmdTokens = (Tcl_Command *)
- Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS+1));
- for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS+1 ; ++newEntry) {
+ Tcl_Alloc(sizeof(Tcl_Command) * (MAX_REGISTERED_COMMANDS));
+ for (newEntry=0 ; newEntry<MAX_REGISTERED_COMMANDS ; ++newEntry) {
cmdTokens[newEntry] = NULL;
}
Tcl_SetHashValue(entryPtr, cmdTokens);
@@ -89,8 +101,9 @@ static void
PkguaDeleteTokens(
Tcl_Interp *interp)
{
+ ThreadSpecificData *tsdPtr = (ThreadSpecificData *)Tcl_GetThreadData((&dataKey), sizeof(ThreadSpecificData));
Tcl_HashEntry *entryPtr =
- Tcl_FindHashEntry(&interpTokenMap, (char *) interp);
+ Tcl_FindHashEntry(&tsdPtr->interpTokenMap, (char *) interp);
if (entryPtr) {
Tcl_Free((char *) Tcl_GetHashValue(entryPtr));
@@ -200,7 +213,7 @@ Pkgua_Init(
Tcl_Interp *interp) /* Interpreter in which the package is to be
* made available. */
{
- int code, cmdIndex = 0;
+ int code;
Tcl_Command *cmdTokens;
if (Tcl_InitStubs(interp, "8.5", 0) == NULL) {
@@ -208,7 +221,7 @@ Pkgua_Init(
}
/*
- * Initialise our Hash table, where we store the registered command tokens
+ * Initialize our Hash table, where we store the registered command tokens
* for each interpreter.
*/
@@ -222,12 +235,12 @@ Pkgua_Init(
Tcl_SetVar2(interp, "::pkgua_loaded", NULL, ".", TCL_APPEND_VALUE);
cmdTokens = PkguaInterpToTokens(interp);
- cmdTokens[cmdIndex++] =
- Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, NULL,
- NULL);
- cmdTokens[cmdIndex++] =
+ cmdTokens[0] =
+ Tcl_CreateObjCommand(interp, "pkgua_eq", PkguaEqObjCmd, &cmdTokens[0],
+ CommandDeleted);
+ cmdTokens[1] =
Tcl_CreateObjCommand(interp, "pkgua_quote", PkguaQuoteObjCmd,
- NULL, NULL);
+ &cmdTokens[1], CommandDeleted);
return TCL_OK;
}
--
cgit v0.12
From d80a12f06122cfef8370e25e4bfe14d180130f7e Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 20 May 2021 12:21:33 +0000
Subject: Fix [52cc90776c]: Warning when compile with gcc v9.3.0
---
generic/tclExecute.c | 4 ++--
1 file changed, 2 insertions(+), 2 deletions(-)
diff --git a/generic/tclExecute.c b/generic/tclExecute.c
index 1d5a0e8..d675e44 100644
--- a/generic/tclExecute.c
+++ b/generic/tclExecute.c
@@ -6090,7 +6090,7 @@ TEBCresume(
{
ClientData ptr1, ptr2;
int type1, type2;
- long l1, l2, lResult;
+ long l1 = 0, l2, lResult;
case INST_NUM_TYPE:
if (GetNumberFromObj(NULL, OBJ_AT_TOS, &ptr1, &type1) != TCL_OK) {
@@ -9277,7 +9277,7 @@ ExecuteExtendedUnaryMathOp(
int opcode, /* What operation to perform. */
Tcl_Obj *valuePtr) /* The operand on the stack. */
{
- ClientData ptr;
+ ClientData ptr = NULL;
int type;
Tcl_WideInt w;
mp_int big;
--
cgit v0.12
From 3a1e4084649144c296b41ac714553bad357782d2 Mon Sep 17 00:00:00 2001
From: "jan.nijtmans" <nijtmans@users.sourceforge.net>
Date: Thu, 20 May 2021 12:26:27 +0000
Subject: Make all "pkg?" package names lowercase (was: ""Pkg?"), as we now
recommend lowercase package names. Let's provide good examples then.
---
tests/load.test | 32 ++++++++++++++++----------------
tests/pkgMkIndex.test | 8 ++++----
tests/unload.test | 20 ++++++++++----------
unix/dltest/pkga.c | 2 +-
unix/dltest/pkgb.c | 6 +++---
unix/dltest/pkgc.c | 4 ++--
unix/dltest/pkgd.c | 4 ++--
unix/dltest/pkgooa.c | 2 +-
unix/dltest/pkgua.c | 2 +-
9 files changed, 40 insertions(+), 40 deletions(-)
diff --git a/tests/load.test b/tests/load.test
index b13f1f4..728fad9 100644
--- a/tests/load.test
+++ b/tests/load.test
@@ -5,7 +5,7 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -78,13 +78,13 @@ 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"}}
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
+ list [catch {load [file join $testDir pkgc$ext] Foo} msg] $msg $errorCode
} -match glob \
-result [list 1 {cannot find symbol "Foo_Init"*} \
{TCL LOOKUP LOAD_SYMBOL *Foo_Init}]
@@ -94,7 +94,7 @@ test load-2.4 {loading with no _SafeInit procedure} [list $dll $loaded] {
test load-3.1 {error in _Init procedure, same interpreter} \
[list $dll $loaded] {
- list [catch {load [file join $testDir pkge$ext] pkge} msg] \
+ list [catch {load [file join $testDir pkge$ext] Pkge} msg] \
$msg $::errorInfo $::errorCode
} {1 {couldn't open "non_existent": no such file or directory} {couldn't open "non_existent": no such file or directory
while executing
@@ -102,14 +102,14 @@ test load-3.1 {error in _Init procedure, same interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
-"load [file join $testDir pkge$ext] pkge"} {POSIX ENOENT {no such file or directory}}}
+"load [file join $testDir pkge$ext] Pkge"} {POSIX ENOENT {no such file or directory}}}
test load-3.2 {error in _Init procedure, child interpreter} \
[list $dll $loaded] {
catch {interp delete x}
interp create x
set ::errorCode foo
set ::errorInfo bar
- set result [list [catch {load [file join $testDir pkge$ext] pkge x} msg] \
+ set result [list [catch {load [file join $testDir pkge$ext] Pkge x} msg] \
$msg $::errorInfo $::errorCode]
interp delete x
set result
@@ -119,23 +119,23 @@ test load-3.2 {error in _Init procedure, child interpreter} \
invoked from within
"if 44 {open non_existent}"
invoked from within
-"load [file join $testDir pkge$ext] pkge x"} {POSIX ENOENT {no such file or directory}}}
+"load [file join $testDir pkge$ext] Pkge x"} {POSIX ENOENT {no such file or directory}}}
test load-4.1 {reloading package into same interpreter} [list $dll $loaded] {
- list [catch {load [file join $testDir pkga$ext] pkga} msg] $msg
+ 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}
+ catch {load [file join $testDir pkga$ext] Pkga}
} -constraints [list $dll $loaded] -returnCodes error -body {
- load [file join $testDir pkga$ext] pkgb
+ 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}
interp create x
} -constraints [list $dll $loaded] -body {
- load -global [file join $testDir pkga$ext] pkga
- load {} pkga x
+ load -global [file join $testDir pkga$ext] Pkga
+ load {} Pkga x
info loaded x
} -cleanup {
interp delete x
@@ -171,9 +171,9 @@ test load-7.3 {Tcl_StaticPackage procedure} [list teststaticpkg] {
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}
+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]]
test load-7.4 {Tcl_StaticPackage procedure, redundant calls} -setup {
teststaticpkg Test 1 0
@@ -209,7 +209,7 @@ test load-8.3b {TclGetLoadedPackages procedure} [list teststaticpkg_8.x $dll $lo
lsort -index 1 [info loaded child]
} [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}]
interp delete child
diff --git a/tests/pkgMkIndex.test b/tests/pkgMkIndex.test
index ad328f8..79e0f2e 100644
--- a/tests/pkgMkIndex.test
+++ b/tests/pkgMkIndex.test
@@ -5,7 +5,7 @@
# Sourcing this file into Tcl runs the tests and generates output for errors.
# No output means no errors were found.
#
-# Copyright (c) 1998-1999 by Scriptics Corporation.
+# Copyright (c) 1998-1999 Scriptics Corporation.
# All rights reserved.
if {"::tcltest" ni [namespace children]} {
@@ -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
diff --git a/tests/unload.test b/tests/unload.test
index 32767fa..0b10492 100644
--- a/tests/unload.test
+++ b/tests/unload.test
@@ -5,8 +5,8 @@
# generates output for errors. No output means no errors were found.
#
# Copyright (c) 1995 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2003-2004 by Georgios Petasis
+# Copyright (c) 1998-1999 Scriptics Corporation.
+# Copyright (c) 2003-2004 Georgios Petasis
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
@@ -135,14 +135,14 @@ child eval {
test unload-3.1 {basic loading of non-unloadable package in a safe interpreter, with package name conversion} \
[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} \
[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}]
@@ -154,14 +154,14 @@ 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
} -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
+ load [file join $testDir pkgua$ext] Pkgua child
}
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
@@ -189,7 +189,7 @@ test unload-3.7 {basic unloading of re-loaded package from a safe interpreter, w
}
} -constraints [list $dll $loaded] -body {
list [child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}] \
- [unload [file join $testDir pkgua$ext] pKgUa child] \
+ [unload [file join $testDir pkgua$ext] Pkgua child] \
[child eval info commands pkgua_*] \
[child eval {list $pkgua_loaded $pkgua_detached $pkgua_unloaded}]
} -result {{.. . .} {} {} {.. .. ..}}
@@ -224,7 +224,7 @@ 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}]
@@ -234,7 +234,7 @@ test unload-4.3 {basic loading of unloadable package in a second trusted interpr
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}]
@@ -291,7 +291,7 @@ test unload-5.1 {unload a module loaded from vfs} \
set dir [pwd]
cd $testDir
testsimplefilesystem 1
- load simplefs:/pkgua$ext pkgua
+ load simplefs:/pkgua$ext Pkgua
} \
-body {
list [catch {unload simplefs:/pkgua$ext} msg] $msg
diff --git a/unix/dltest/pkga.c b/unix/dltest/pkga.c
index 77526b7..ff8f000 100644
--- a/unix/dltest/pkga.c
+++ b/unix/dltest/pkga.c
@@ -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;
}
diff --git a/unix/dltest/pkgb.c b/unix/dltest/pkgb.c
index 5618871..29f4a23 100644
--- a/unix/dltest/pkgb.c
+++ b/unix/dltest/pkgb.c
@@ -149,10 +149,10 @@ Pkgb_Init(
{
int code;
- if (Tcl_InitStubs(interp, "8.5-", 0) == NULL) {
+ 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;
}
@@ -189,7 +189,7 @@ Pkgb_SafeInit(
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;
}
diff --git a/unix/dltest/pkgc.c b/unix/dltest/pkgc.c
index 59083a8..23bb2e5 100644
--- a/unix/dltest/pkgc.c
+++ b/unix/dltest/pkgc.c
@@ -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;
}
diff --git a/unix/dltest/pkgd.c b/unix/dltest/pkgd.c
index ae96971..d51dd6a 100644
--- a/unix/dltest/pkgd.c
+++ b/unix/dltest/pkgd.c
@@ -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;
}
diff --git a/unix/dltest/pkgooa.c b/unix/dltest/pkgooa.c
index b2b4495..8dea0aa 100644
--- a/unix/dltest/pkgooa.c
+++ b/unix/dltest/pkgooa.c
@@ -141,7 +141,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;
}
diff --git a/unix/dltest/pkgua.c b/unix/dltest/pkgua.c
index 07556d1..ad2b2b3 100644
--- a/unix/dltest/pkgua.c
+++ b/unix/dltest/pkgua.c
@@ -227,7 +227,7 @@ Pkgua_Init(
PkguaInitTokensHashTable();
- code = Tcl_PkgProvide(interp, "Pkgua", "1.0");
+ code = Tcl_PkgProvide(interp, "pkgua", "1.0");
if (code != TCL_OK) {
return code;
}
--
cgit v0.12