From 4ae04fa40387165f811a88d87a1140a07bf10215 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 6 Feb 2014 21:44:43 +0000 Subject: Check for existance of __BORLANDC__ before using its value --- generic/tcl.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tcl.h b/generic/tcl.h index 31960ec..5300bba 100644 --- a/generic/tcl.h +++ b/generic/tcl.h @@ -168,7 +168,7 @@ extern "C" { * MSVCRT. */ -#if (defined(__WIN32__) && (defined(_MSC_VER) || (__BORLANDC__ >= 0x0550) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec)))) +#if (defined(__WIN32__) && (defined(_MSC_VER) || (defined(__BORLANDC__) && (__BORLANDC__ >= 0x0550)) || defined(__LCC__) || defined(__WATCOMC__) || (defined(__GNUC__) && defined(__declspec)))) # define HAVE_DECLSPEC 1 # ifdef STATIC_BUILD # define DLLIMPORT -- cgit v0.12 From 6e78f7a617b001eb5e35fe11cad2f469c0f48320 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Feb 2014 22:38:17 +0000 Subject: [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. --- generic/tclBasic.c | 39 +++++++++++++++++++++++++++++---------- generic/tclInt.h | 1 + tests/namespace.test | 9 +++++++++ 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_*]} -- cgit v0.12 From 32a6fce0618ed21d85cf47b4b842ea9ee2c0c2e6 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 6 Feb 2014 22:41:14 +0000 Subject: Change the flag value to avoid merge conflict with trunk. --- generic/tclInt.h | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclInt.h b/generic/tclInt.h index f869ff0..1348340 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -1528,7 +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 +#define CMD_REDEF_IN_PROGRESS 0x10 /* *---------------------------------------------------------------- -- cgit v0.12