summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordgp <dgp@users.sourceforge.net>2014-02-06 22:38:17 (GMT)
committerdgp <dgp@users.sourceforge.net>2014-02-06 22:38:17 (GMT)
commit6e78f7a617b001eb5e35fe11cad2f469c0f48320 (patch)
tree1dcd49e5460f08137bd685f431b862090082fc7b
parent4ae04fa40387165f811a88d87a1140a07bf10215 (diff)
downloadtcl-6e78f7a617b001eb5e35fe11cad2f469c0f48320.zip
tcl-6e78f7a617b001eb5e35fe11cad2f469c0f48320.tar.gz
tcl-6e78f7a617b001eb5e35fe11cad2f469c0f48320.tar.bz2
[a4494e28ed] Use flag bit instead of NULL pointer to suppress teardown list of
imported commands when the original command gets re-created. This prevents the panic otherwise possible when the invalid state represented by the NULL pointer is encountered during a command delete trace.
-rw-r--r--generic/tclBasic.c39
-rw-r--r--generic/tclInt.h1
-rw-r--r--tests/namespace.test9
3 files changed, 39 insertions, 10 deletions
diff --git a/generic/tclBasic.c b/generic/tclBasic.c
index c3ab871..89d6b8f 100644
--- a/generic/tclBasic.c
+++ b/generic/tclBasic.c
@@ -1887,10 +1887,19 @@ Tcl_CreateCommand(
*/
cmdPtr = Tcl_GetHashValue(hPtr);
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2061,10 +2070,19 @@ Tcl_CreateObjCommand(
* intact.
*/
- oldRefPtr = cmdPtr->importRefPtr;
- cmdPtr->importRefPtr = NULL;
+ cmdPtr->refCount++;
+ if (cmdPtr->importRefPtr) {
+ cmdPtr->flags |= CMD_REDEF_IN_PROGRESS;
+ }
Tcl_DeleteCommandFromToken(interp, (Tcl_Command) cmdPtr);
+
+ if (cmdPtr->flags & CMD_REDEF_IN_PROGRESS) {
+ oldRefPtr = cmdPtr->importRefPtr;
+ cmdPtr->importRefPtr = NULL;
+ }
+ TclCleanupCommandMacro(cmdPtr);
+
hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew);
if (!isNew) {
/*
@@ -2869,12 +2887,13 @@ Tcl_DeleteCommandFromToken(
* commands were created that refer back to this command. Delete these
* imported commands now.
*/
-
- for (refPtr = cmdPtr->importRefPtr; refPtr != NULL;
- refPtr = nextRefPtr) {
- nextRefPtr = refPtr->nextPtr;
- importCmd = (Tcl_Command) refPtr->importedCmdPtr;
- Tcl_DeleteCommandFromToken(interp, importCmd);
+ 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);
+ }
}
/*
diff --git a/generic/tclInt.h b/generic/tclInt.h
index b45f8e3..f869ff0 100644
--- a/generic/tclInt.h
+++ b/generic/tclInt.h
@@ -1528,6 +1528,7 @@ typedef struct Command {
#define CMD_IS_DELETED 0x1
#define CMD_TRACE_ACTIVE 0x2
#define CMD_HAS_EXEC_TRACES 0x4
+#define CMD_REDEF_IN_PROGRESS 0x8
/*
*----------------------------------------------------------------
diff --git a/tests/namespace.test b/tests/namespace.test
index 4eecac1..b59e09e 100644
--- a/tests/namespace.test
+++ b/tests/namespace.test
@@ -556,6 +556,15 @@ test namespace-13.1 {DeleteImportedCmd, deletes imported cmds} {
lappend l [info commands ::test_ns_import::*]
}
} {::test_ns_import::cmd1 {}}
+test namespace-13.2 {DeleteImportedCmd, Bug a4494e28ed} {
+ # Will panic if still buggy
+ namespace eval src {namespace export foo; proc foo {} {}}
+ namespace eval dst {namespace import [namespace parent]::src::foo}
+ trace add command src::foo delete \
+ "[list namespace delete [namespace current]::dst] ;#"
+ proc src::foo {} {}
+ namespace delete src
+} {}
test namespace-14.1 {TclGetNamespaceForQualName, absolute names} {
catch {namespace delete {*}[namespace children :: test_ns_*]}