From 6832ae16ff4f18e496fe00d20334e627e2acf525 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 1 Sep 2017 13:48:56 +0000 Subject: Handle Unicode surrogates correctly in Tcl_AppendFormatToObj() and BuildCharSet(). Only makes a difference for TCL_UTF_MAX=4, when surrogates are used in the format string ... highly unlikely corner-case. --- generic/tclScan.c | 4 ++-- generic/tclStringObj.c | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclScan.c b/generic/tclScan.c index 7a6a8a2..e1fcad4 100644 --- a/generic/tclScan.c +++ b/generic/tclScan.c @@ -72,7 +72,7 @@ BuildCharSet( CharSet *cset, const char *format) /* Points to first char of set. */ { - Tcl_UniChar ch, start; + Tcl_UniChar ch = 0, start; int offset, nranges; const char *end; @@ -582,7 +582,7 @@ Tcl_ScanObjCmd( char op = 0; int width, underflow = 0; Tcl_WideInt wideValue; - Tcl_UniChar ch, sch; + Tcl_UniChar ch = 0, sch = 0; Tcl_Obj **objs = NULL, *objPtr = NULL; int flags; char buf[513]; /* Temporary buffer to hold scanned number diff --git a/generic/tclStringObj.c b/generic/tclStringObj.c index 6d97881..01b044e 100644 --- a/generic/tclStringObj.c +++ b/generic/tclStringObj.c @@ -1682,6 +1682,7 @@ Tcl_AppendFormatToObj( const char *span = format, *msg, *errCode; int numBytes = 0, objIndex = 0, gotXpg = 0, gotSequential = 0; int originalLength, limit; + Tcl_UniChar ch = 0; static const char *mixedXPG = "cannot mix \"%\" and \"%n$\" conversion specifiers"; static const char *const badIndex[2] = { @@ -1709,7 +1710,6 @@ Tcl_AppendFormatToObj( #endif int newXpg, numChars, allocSegment = 0, segmentLimit, segmentNumBytes; Tcl_Obj *segment; - Tcl_UniChar ch = 0; int step = TclUtfToUniChar(format, &ch); format += step; -- cgit v0.12 From 5d7ae02a8ce96d7fbec18af96fbe91a775f126d3 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Sep 2017 19:35:22 +0000 Subject: [Bug 0e4d88b650] First draft fix. Re-resolve namespace after cmd deletion. --- generic/tclBasic.c | 28 ++++++++++++++++++++-------- 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 44cf543..fddce1a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2017,7 +2017,7 @@ Tcl_CreateObjCommand( Command *cmdPtr, *refCmdPtr; Tcl_HashEntry *hPtr; const char *tail; - int isNew; + int isNew = 0, deleted = 0; ImportedCmdData *dataPtr; if (iPtr->flags & DELETED) { @@ -2030,6 +2030,14 @@ Tcl_CreateObjCommand( } /* + * If the command name we seek to create already exists, we need to + * delete that first. That can be tricky in the presence of traces. + * Loop until we no longer find an existing command in the way. + */ + + while (1) { + + /* * Determine where the command should reside. If its name contains * namespace qualifiers, we put it in the specified namespace; otherwise, * we always put it in the global namespace. @@ -2047,11 +2055,13 @@ Tcl_CreateObjCommand( } hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - TclInvalidateNsPath(nsPtr); - if (!isNew) { - cmdPtr = Tcl_GetHashValue(hPtr); + + if (isNew || deleted) { + break; + } /* Command already exists. */ + cmdPtr = Tcl_GetHashValue(hPtr); /* * [***] This is wrong. See Tcl Bug a16752c252. @@ -2089,8 +2099,8 @@ Tcl_CreateObjCommand( cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); - - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + deleted = 1; + } if (!isNew) { /* * If the deletion callback recreated the command, just throw away @@ -2100,7 +2110,8 @@ Tcl_CreateObjCommand( ckfree(Tcl_GetHashValue(hPtr)); } - } else { + + if (!deleted) { /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we @@ -2108,7 +2119,8 @@ Tcl_CreateObjCommand( */ TclInvalidateNsCmdLookup(nsPtr); - } + TclInvalidateNsPath(nsPtr); + } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; -- cgit v0.12 From 37007afa53b17d5e10c1553a2af898dba2f886e1 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Sep 2017 20:17:26 +0000 Subject: Tidy up. --- generic/tclBasic.c | 73 ++++++++++++++++++++++++++++++------------------------ 1 file changed, 40 insertions(+), 33 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index fddce1a..7c223e9 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2013,8 +2013,8 @@ Tcl_CreateObjCommand( { Interp *iPtr = (Interp *) interp; ImportRef *oldRefPtr = NULL; - Namespace *nsPtr, *dummy1, *dummy2; - Command *cmdPtr, *refCmdPtr; + Namespace *nsPtr; + Command *cmdPtr; Tcl_HashEntry *hPtr; const char *tail; int isNew = 0, deleted = 0; @@ -2032,35 +2032,41 @@ Tcl_CreateObjCommand( /* * If the command name we seek to create already exists, we need to * delete that first. That can be tricky in the presence of traces. - * Loop until we no longer find an existing command in the way. + * Loop until we no longer find an existing command in the way, or + * until we've deleted one command and that didn't finish the job. */ while (1) { + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ - /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; otherwise, - * we always put it in the global namespace. - */ + if (strstr(cmdName, "::") != NULL) { + Namespace *dummy1, *dummy2; - if (strstr(cmdName, "::") != NULL) { - TclGetNamespaceForQualName(interp, cmdName, NULL, + TclGetNamespaceForQualName(interp, cmdName, NULL, TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); - if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; - } - } else { - nsPtr = iPtr->globalNsPtr; - tail = cmdName; - } + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (isNew || deleted) { - break; - } + if (isNew || deleted) { + /* + * isNew - No conflict with existing command. + * deleted - We've already deleted a conflicting command + */ + break; + } - /* Command already exists. */ + /* An existing command conflicts. Try to delete it.. */ cmdPtr = Tcl_GetHashValue(hPtr); /* @@ -2101,17 +2107,18 @@ Tcl_CreateObjCommand( TclCleanupCommandMacro(cmdPtr); deleted = 1; } - if (!isNew) { - /* - * If the deletion callback recreated the command, just throw away - * the new command (if we try to delete it again, we could get - * stuck in an infinite loop). - */ - ckfree(Tcl_GetHashValue(hPtr)); - } + if (!isNew) { + /* + * If the deletion callback recreated the command, just throw away + * the new command (if we try to delete it again, we could get + * stuck in an infinite loop). + */ - if (!deleted) { + ckfree(Tcl_GetHashValue(hPtr)); + } + + if (!deleted) { /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we @@ -2120,7 +2127,7 @@ Tcl_CreateObjCommand( TclInvalidateNsCmdLookup(nsPtr); TclInvalidateNsPath(nsPtr); - } + } cmdPtr = (Command *) ckalloc(sizeof(Command)); Tcl_SetHashValue(hPtr, cmdPtr); cmdPtr->hPtr = hPtr; @@ -2146,7 +2153,7 @@ Tcl_CreateObjCommand( if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { - refCmdPtr = oldRefPtr->importedCmdPtr; + Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; -- cgit v0.12 From cc912b73a02978ef98876321877d1b923a4a22e5 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Sep 2017 20:40:44 +0000 Subject: Similar fix to Tcl_CreateCommand(). --- generic/tclBasic.c | 85 ++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 54 insertions(+), 31 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 7c223e9..7f75892 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1851,11 +1851,11 @@ Tcl_CreateCommand( { Interp *iPtr = (Interp *) interp; ImportRef *oldRefPtr = NULL; - Namespace *nsPtr, *dummy1, *dummy2; - Command *cmdPtr, *refCmdPtr; + Namespace *nsPtr; + Command *cmdPtr; Tcl_HashEntry *hPtr; const char *tail; - int isNew; + int isNew = 0, deleted = 0; ImportedCmdData *dataPtr; if (iPtr->flags & DELETED) { @@ -1868,32 +1868,52 @@ Tcl_CreateCommand( } /* - * Determine where the command should reside. If its name contains - * namespace qualifiers, we put it in the specified namespace; otherwise, - * we always put it in the global namespace. + * If the command name we seek to create already exists, we need to + * delete that first. That can be tricky in the presence of traces. + * Loop until we no longer find an existing command in the way, or + * until we've deleted one command and that didn't finish the job. */ - if (strstr(cmdName, "::") != NULL) { - TclGetNamespaceForQualName(interp, cmdName, NULL, - TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); - if ((nsPtr == NULL) || (tail == NULL)) { - return (Tcl_Command) NULL; - } - } else { - nsPtr = iPtr->globalNsPtr; - tail = cmdName; - } + while (1) { + /* + * Determine where the command should reside. If its name contains + * namespace qualifiers, we put it in the specified namespace; + * otherwise, we always put it in the global namespace. + */ - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (!isNew) { + if (strstr(cmdName, "::") != NULL) { + Namespace *dummy1, *dummy2; + + TclGetNamespaceForQualName(interp, cmdName, NULL, + TCL_CREATE_NS_IF_UNKNOWN, &nsPtr, &dummy1, &dummy2, &tail); + if ((nsPtr == NULL) || (tail == NULL)) { + return (Tcl_Command) NULL; + } + } else { + nsPtr = iPtr->globalNsPtr; + tail = cmdName; + } + + hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); + + if (isNew || deleted) { + /* + * isNew - No conflict with existing command. + * deleted - We've already deleted a conflicting command + */ + break; + } + + /* An existing command conflicts. Try to delete it.. */ + cmdPtr = Tcl_GetHashValue(hPtr); + /* - * Command already exists. Delete the old one. Be careful to preserve + * Be careful to preserve * any existing import links so we can restore them down below. That * way, you can redefine a command and its import status will remain * intact. */ - cmdPtr = Tcl_GetHashValue(hPtr); cmdPtr->refCount++; if (cmdPtr->importRefPtr) { cmdPtr->flags |= CMD_REDEF_IN_PROGRESS; @@ -1906,18 +1926,21 @@ Tcl_CreateCommand( cmdPtr->importRefPtr = NULL; } TclCleanupCommandMacro(cmdPtr); + deleted = 1; + } - hPtr = Tcl_CreateHashEntry(&nsPtr->cmdTable, tail, &isNew); - if (!isNew) { - /* - * If the deletion callback recreated the command, just throw away - * the new command (if we try to delete it again, we could get - * stuck in an infinite loop). - */ + if (!isNew) { + /* + * If the deletion callback recreated the command, just throw away + * the new command (if we try to delete it again, we could get + * stuck in an infinite loop). + */ + + ckfree((char *) Tcl_GetHashValue(hPtr)); + } + + if (!deleted) { - ckfree((char *) Tcl_GetHashValue(hPtr)); - } - } else { /* * The list of command exported from the namespace might have changed. * However, we do not need to recompute this just yet; next time we @@ -1952,7 +1975,7 @@ Tcl_CreateCommand( if (oldRefPtr != NULL) { cmdPtr->importRefPtr = oldRefPtr; while (oldRefPtr != NULL) { - refCmdPtr = oldRefPtr->importedCmdPtr; + Command *refCmdPtr = oldRefPtr->importedCmdPtr; dataPtr = refCmdPtr->objClientData; dataPtr->realCmdPtr = cmdPtr; oldRefPtr = oldRefPtr->nextPtr; -- cgit v0.12 From 39efd5474116799b123d4082bca3a9c30c7b8b82 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 2 Sep 2017 21:14:55 +0000 Subject: Add test --- tests/basic.test | 15 +++++++++++++++ 1 file changed, 15 insertions(+) diff --git a/tests/basic.test b/tests/basic.test index 91e4d6c..e4b46fd 100644 --- a/tests/basic.test +++ b/tests/basic.test @@ -221,6 +221,21 @@ test basic-15.1 {Tcl_CreateObjCommand, new cmd goes into a namespace specified i list [test_ns_basic::cmd] \ [namespace delete test_ns_basic] } {::test_ns_basic {}} +test basic-15.2 {Tcl_CreateObjCommand, Bug 0e4d88b650} -setup { + proc deleter {ns args} { + namespace delete $ns + } + namespace eval n { + proc p {} {} + } + trace add command n::p delete [list [namespace which deleter] [namespace current]::n] +} -body { + proc n::p {} {} +} -cleanup { + namespace delete n + rename deleter {} +} + test basic-16.1 {TclInvokeStringCommand} {emptyTest} { } {} -- cgit v0.12 From 00deed9129815de66856273e30bc92649e6c111b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Sep 2017 12:37:04 +0000 Subject: Typo's (Thanks to Gustaf Neumann), nothing functional. --- generic/tclBasic.c | 2 +- generic/tclEncoding.c | 4 ++-- 2 files changed, 3 insertions(+), 3 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 36d2301..acdcf41 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -2097,7 +2097,7 @@ Tcl_CreateCommand( /* An existing command conflicts. Try to delete it.. */ cmdPtr = Tcl_GetHashValue(hPtr); - + /* * Be careful to preserve * any existing import links so we can restore them down below. That diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 8450128..2548b73 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -2329,7 +2329,7 @@ UtfToUtfProc( } if (UCHAR(*src) < 0x80 && !(UCHAR(*src) == 0 && pureNullMode == 0)) { /* - * Copy 7bit chatacters, but skip null-bytes when we are in input + * Copy 7bit characters, but skip null-bytes when we are in input * mode, so that they get converted to 0xc080. */ @@ -3374,7 +3374,7 @@ EscapeFromUtfProc( /* * The state variable has the value of oldState when word is 0. - * In this case, the escape sequense should not be copied to dst + * In this case, the escape sequence should not be copied to dst * because the current character set is not changed. */ -- cgit v0.12 From 0477cb15f93e08f2ef2651122ec92163cbf621c0 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 4 Sep 2017 13:59:04 +0000 Subject: Make pkgIndex.tcl from msgcat work for Tcl 9.0 (not really necessary, but for consistancy) --- library/msgcat/pkgIndex.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/msgcat/pkgIndex.tcl b/library/msgcat/pkgIndex.tcl index 7cdb703..72c5dc0 100644 --- a/library/msgcat/pkgIndex.tcl +++ b/library/msgcat/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.5]} {return} +if {![package vsatisfies [package provide Tcl] 8.5-]} {return} package ifneeded msgcat 1.6.1 [list source [file join $dir msgcat.tcl]] -- cgit v0.12