From 654dc20b4af9b37825f7faffaa0e714dad02ce92 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 15 Jul 2013 19:09:59 +0000 Subject: Possible improvement in light of [86ceb4e2b6]. --- library/tm.tcl | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/library/tm.tcl b/library/tm.tcl index d2af4f5..955e84d 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -238,6 +238,15 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } + if {[string length [package ifneeded $pkgname $pkgversion]]} { + # There's already a provide script registered for + # this version of this package. Since all units of + # code claiming to be the same version of the same + # package ought to be identical, just stick with + # the one we already have. + continue + } + # We have found a candidate, generate a "provide script" # for it, and remember it. Note that we are using ::list # to do this; locally [list] means something else without -- cgit v0.12 From 7ef78ec33dcd4cf57d272e36d542a1c3c088495a Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 21 Aug 2013 09:35:50 +0000 Subject: define tests for this bug; no fix yet --- tests/oo.test | 30 ++++++++++++++++++++++++++++++ 1 file changed, 30 insertions(+) diff --git a/tests/oo.test b/tests/oo.test index e0e0791..054bc46 100644 --- a/tests/oo.test +++ b/tests/oo.test @@ -1839,6 +1839,36 @@ test oo-15.9 {ensemble rewriting must not bleed through oo::copy} -setup { } -returnCodes error -cleanup { Foo destroy } -result {wrong # args: should be "::bar a b"} +test oo-15.10 {variable binding must not bleed through oo::copy} -setup { + oo::class create FooClass + set result {} +} -body { + set obj1 [FooClass new] + oo::objdefine $obj1 { + variable var + method m {} { + set var foo + } + method get {} { + return $var + } + export eval + } + + $obj1 m + lappend result [$obj1 get] + set obj2 [oo::copy $obj1] + $obj2 eval { + set var bar + } + lappend result [$obj2 get] + $obj1 eval { + set var grill + } + lappend result [$obj1 get] [$obj2 get] +} -cleanup { + FooClass destroy +} -result {foo bar grill bar} test oo-16.1 {OO: object introspection} -body { info object -- cgit v0.12 From 0576e11ae0dee27fb806110d84024c8aff28f941 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 1 Sep 2013 20:08:50 +0000 Subject: [b98fa55285]: Fix handling of whitespace at end of hex strings to decode. --- ChangeLog | 6 ++++++ generic/tclBinary.c | 43 +++++++++++++++++++++++-------------------- tests/binary.test | 28 ++++++++++++++++++++++++++++ 3 files changed, 57 insertions(+), 20 deletions(-) diff --git a/ChangeLog b/ChangeLog index ddde893..e0b623b 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,9 @@ +2013-09-01 Donal Fellows + + * generic/tclBinary.c (BinaryDecodeHex): [Bug b98fa55285]: Ensure that + whitespace at the end of a string don't cause the decoder to drop the + last decoded byte. + 2013-08-03 Donal Fellows * library/auto.tcl: [Patch 3611643]: Allow TclOO classes to be found diff --git a/generic/tclBinary.c b/generic/tclBinary.c index 901237b..7625d39 100644 --- a/generic/tclBinary.c +++ b/generic/tclBinary.c @@ -2386,29 +2386,32 @@ BinaryDecodeHex( while (data < dataend) { value = 0; for (i=0 ; i<2 ; i++) { - if (data < dataend) { - c = *data++; - - if (!isxdigit((int) c)) { - if (strict || !isspace(c)) { - goto badChar; - } - i--; - continue; - } + if (data >= dataend) { value <<= 4; - c -= '0'; - if (c > 9) { - c += ('0' - 'A') + 10; - } - if (c > 16) { - c += ('A' - 'a'); + break; + } + + c = *data++; + if (!isxdigit((int) c)) { + if (strict || !isspace(c)) { + goto badChar; } - value |= (c & 0xf); - } else { - value <<= 4; - cut++; + i--; + continue; } + + value <<= 4; + c -= '0'; + if (c > 9) { + c += ('0' - 'A') + 10; + } + if (c > 16) { + c += ('A' - 'a'); + } + value |= (c & 0xf); + } + if (i < 2) { + cut++; } *cursor++ = UCHAR(value); value = 0; diff --git a/tests/binary.test b/tests/binary.test index 4393245..d424837 100644 --- a/tests/binary.test +++ b/tests/binary.test @@ -2499,6 +2499,34 @@ test binary-71.9 {binary decode hex} -body { test binary-71.10 {binary decode hex} -body { string length [binary decode hex " "] } -result 0 +test binary-71.11 {binary decode hex: Bug b98fa55285} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c26\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {29 38} +test binary-71.12 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} +test binary-71.13 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} +test binary-71.14 {binary decode hex: Bug b98fa55285 cross check} -body { + apply {{} { + set str "137b6f95e7519389e7c4b36599781e2ccf492699649249aae43fbe8c2\n\n\n" + set decoded [binary decode hex $str] + list [string length $decoded] [scan [string index $decoded end] %c] + }} +} -result {28 140} test binary-72.1 {binary encode base64} -body { binary encode base64 -- cgit v0.12 From 5441277b9a31d73e4d91383584882c9303e5c758 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Mon, 2 Sep 2013 14:01:00 +0000 Subject: typo --- tests/zlib.test | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/tests/zlib.test b/tests/zlib.test index c469eea..2ea185f 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -233,7 +233,7 @@ test zlib-8.7 {transformation and fconfigure} -setup { # Dictionary is that which is proposed _in_ SPDY draft set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n" set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl" -test zlib-8.8 {transformtion and fconfigure} -setup { +test zlib-8.8 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push compress $outSide -dictionary $spdyDict @@ -250,7 +250,7 @@ test zlib-8.8 {transformtion and fconfigure} -setup { catch {close $outSide} catch {close $inSide} } -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010} -test zlib-8.9 {transformtion and fconfigure} -setup { +test zlib-8.9 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream decompress] } -constraints zlib -body { @@ -267,7 +267,7 @@ test zlib-8.9 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {3064818174 358 358} -test zlib-8.10 {transformtion and fconfigure} -setup { +test zlib-8.10 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide } -constraints zlib -body { zlib push deflate $outSide -dictionary $spdyDict @@ -284,7 +284,7 @@ test zlib-8.10 {transformtion and fconfigure} -setup { catch {close $outSide} catch {close $inSide} } -result {254 212 {data error} {TCL ZLIB DATA}} -test zlib-8.11 {transformtion and fconfigure} -setup { +test zlib-8.11 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream inflate] } -constraints zlib -body { @@ -300,7 +300,7 @@ test zlib-8.11 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358} -test zlib-8.12 {transformtion and fconfigure} -setup { +test zlib-8.12 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { @@ -317,7 +317,7 @@ test zlib-8.12 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} -test zlib-8.13 {transformtion and fconfigure} -setup { +test zlib-8.13 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream compress] } -constraints zlib -body { @@ -334,7 +334,7 @@ test zlib-8.13 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358 3064818174} -test zlib-8.14 {transformtion and fconfigure} -setup { +test zlib-8.14 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { @@ -350,7 +350,7 @@ test zlib-8.14 {transformtion and fconfigure} -setup { catch {close $inSide} catch {$strm close} } -result {358 358} -test zlib-8.15 {transformtion and fconfigure} -setup { +test zlib-8.15 {transformation and fconfigure} -setup { lassign [chan pipe] inSide outSide set strm [zlib stream deflate] } -constraints zlib -body { -- cgit v0.12 From a01e0439ec88f4f83820d36da9ed018cc3b9ff00 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 Sep 2013 17:59:42 +0000 Subject: [010f4162ef] First step of fix on stammering errorstack. errorstack fixed. errorinfo revision still under consideration. --- generic/tclBasic.c | 6 ++++++ 1 file changed, 6 insertions(+) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 884b5cc..e909a1a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4679,6 +4679,9 @@ TEOV_RunEnterTraces( TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { + if (traceCode == TCL_ERROR) { + iPtr->flags |= ERR_ALREADY_LOGGED; + } return traceCode; } if (cmdEpoch != newEpoch) { @@ -4725,6 +4728,9 @@ TEOV_RunLeaveTraces( TclCleanupCommandMacro(cmdPtr); if (traceCode != TCL_OK) { + if (traceCode == TCL_ERROR) { + iPtr->flags |= ERR_ALREADY_LOGGED; + } return traceCode; } return result; -- cgit v0.12 From bfee748b41a556c2c213d22b99ce12b156acb1d8 Mon Sep 17 00:00:00 2001 From: dgp Date: Mon, 2 Sep 2013 18:47:07 +0000 Subject: Add test and improve errorInfo. --- generic/tclBasic.c | 22 ++++++++++++++++------ tests/error.test | 10 ++++++++++ 2 files changed, 26 insertions(+), 6 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index e909a1a..a10a11a 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -4680,6 +4680,12 @@ TEOV_RunEnterTraces( if (traceCode != TCL_OK) { if (traceCode == TCL_ERROR) { + Tcl_Obj *info; + + TclNewLiteralStringObj(info, "\n (enter trace on \""); + Tcl_AppendLimitedToObj(info, command, length, 55, "..."); + Tcl_AppendToObj(info, "\")", 2); + Tcl_AppendObjToErrorInfo(interp, info); iPtr->flags |= ERR_ALREADY_LOGGED; } return traceCode; @@ -4702,12 +4708,10 @@ TEOV_RunLeaveTraces( Tcl_Obj *commandPtr = data[1]; Command *cmdPtr = data[2]; Tcl_Obj **objv = data[3]; - + int length; + const char *command = Tcl_GetStringFromObj(commandPtr, &length); if (!(cmdPtr->flags & CMD_IS_DELETED)) { - int length; - const char *command = Tcl_GetStringFromObj(commandPtr, &length); - if (cmdPtr->flags & CMD_HAS_EXEC_TRACES){ traceCode = TclCheckExecutionTraces(interp, command, length, cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); @@ -4717,7 +4721,6 @@ TEOV_RunLeaveTraces( cmdPtr, result, TCL_TRACE_LEAVE_EXEC, objc, objv); } } - Tcl_DecrRefCount(commandPtr); /* * As cmdPtr is set, TclNRRunCallbacks is about to reduce the numlevels. @@ -4729,10 +4732,17 @@ TEOV_RunLeaveTraces( if (traceCode != TCL_OK) { if (traceCode == TCL_ERROR) { + Tcl_Obj *info; + + TclNewLiteralStringObj(info, "\n (leave trace on \""); + Tcl_AppendLimitedToObj(info, command, length, 55, "..."); + Tcl_AppendToObj(info, "\")", 2); + Tcl_AppendObjToErrorInfo(interp, info); iPtr->flags |= ERR_ALREADY_LOGGED; } - return traceCode; + result = traceCode; } + Tcl_DecrRefCount(commandPtr); return result; } diff --git a/tests/error.test b/tests/error.test index 06f8eca..0de644c 100644 --- a/tests/error.test +++ b/tests/error.test @@ -182,6 +182,16 @@ test error-4.7 {errorstack via options dict } -body { catch {f 12} m d dict get $d -errorstack } -match glob -result {INNER * CALL {g 1212} CALL {f 12} UP 1} +test error-4.8 {errorstack from exec traces} -body { + proc foo args {} + proc goo {} foo + trace add execution foo enter {error bar;#} + catch goo m d + dict get $d -errorstack +} -cleanup { + rename goo {}; rename foo {} + unset -nocomplain m d +} -result {INNER {error bar} CALL goo UP 1} # Errors in error command itself -- cgit v0.12 From 5e237c28521e9a2146369913d30a10b2712b9fc2 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 4 Sep 2013 07:22:45 +0000 Subject: Fix 3 trivial (possible) errors, discovered by covertity.com --- generic/tclUtil.c | 3 +-- unix/tclUnixFCmd.c | 4 ++-- unix/tclUnixSock.c | 2 ++ 3 files changed, 5 insertions(+), 4 deletions(-) diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 27e2474..b089132 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -3580,10 +3580,9 @@ UpdateStringOfEndOffset( register Tcl_Obj *objPtr) { char buffer[TCL_INTEGER_SPACE + 5]; - register int len; + register int len = 3; memcpy(buffer, "end", 4); - len = sizeof("end") - 1; if (objPtr->internalRep.longValue != 0) { buffer[len++] = '-'; len += TclFormatInt(buffer+len, -(objPtr->internalRep.longValue)); diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index e27f78f..e270b6a 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -462,10 +462,10 @@ DoCopyFile( switch ((int) (statBufPtr->st_mode & S_IFMT)) { #ifndef DJGPP case S_IFLNK: { - char linkBuf[MAXPATHLEN]; + char linkBuf[MAXPATHLEN+1]; int length; - length = readlink(src, linkBuf, sizeof(linkBuf)); + length = readlink(src, linkBuf, MAXPATHLEN); /* INTL: Native. */ if (length == -1) { return TCL_ERROR; diff --git a/unix/tclUnixSock.c b/unix/tclUnixSock.c index 9c3d7eb..a6360c2 100644 --- a/unix/tclUnixSock.c +++ b/unix/tclUnixSock.c @@ -1358,6 +1358,7 @@ Tcl_OpenTcpServer( my_errno = errno; } close(sock); + sock = -1; continue; } if (port == 0 && chosenport == 0) { @@ -1380,6 +1381,7 @@ Tcl_OpenTcpServer( my_errno = errno; } close(sock); + sock = -1; continue; } if (statePtr == NULL) { -- cgit v0.12 From f16149f5a641a30843d2bb4e3dd2734e50ecbe14 Mon Sep 17 00:00:00 2001 From: dkf Date: Wed, 4 Sep 2013 09:36:22 +0000 Subject: [98c8b3ec12] Make test fail in less catastrophic manner. --- tests/zlib.test | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/tests/zlib.test b/tests/zlib.test index 2ea185f..0712929 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -276,7 +276,10 @@ test zlib-8.10 {transformation and fconfigure} -setup { puts -nonewline $outSide $spdyHeaders chan pop $outSide set compressed [read $inSide] - catch {zlib inflate $compressed} err opt + catch { + zlib inflate $compressed + throw UNREACHABLE "should be unreachable" + } err opt list [string length [zlib deflate $spdyHeaders]] \ [string length $compressed] \ $err [dict get $opt -errorcode] -- cgit v0.12 From 0a973a55fed4b9cba1558fc7c93d412665f7063c Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 4 Sep 2013 12:45:51 +0000 Subject: Cleaned up test command trying to make valgrind happy. --- generic/tclTest.c | 22 ++++++++++++++++++++-- 1 file changed, 20 insertions(+), 2 deletions(-) diff --git a/generic/tclTest.c b/generic/tclTest.c index 96973d7..f121d0d 100644 --- a/generic/tclTest.c +++ b/generic/tclTest.c @@ -4408,8 +4408,26 @@ TestseterrorcodeCmd( Tcl_SetResult(interp, "too many args", TCL_STATIC); return TCL_ERROR; } - Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], - argv[5], NULL); + switch (argc) { + case 1: + Tcl_SetErrorCode(interp, "NONE", NULL); + break; + case 2: + Tcl_SetErrorCode(interp, argv[1], NULL); + break; + case 3: + Tcl_SetErrorCode(interp, argv[1], argv[2], NULL); + break; + case 4: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], NULL); + break; + case 5: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], NULL); + break; + case 6: + Tcl_SetErrorCode(interp, argv[1], argv[2], argv[3], argv[4], + argv[5], NULL); + } return TCL_ERROR; } -- cgit v0.12 From 133768540d48de8f9bf0638fd9983178588bd18a Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Sep 2013 12:45:11 +0000 Subject: Error in order of #include lines broke some windows builds. --- generic/tclParse.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/generic/tclParse.c b/generic/tclParse.c index c5cb1d1..ee0d4c4 100644 --- a/generic/tclParse.c +++ b/generic/tclParse.c @@ -13,9 +13,9 @@ * this file, and for a DISCLAIMER OF ALL WARRANTIES. */ -#include #include "tclInt.h" #include "tclParse.h" +#include /* * The following table provides parsing information about each possible 8-bit -- cgit v0.12 From 4bba36ca59c3760f9e2a593e8135aa6f8352919e Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Sep 2013 15:47:29 +0000 Subject: Use ne instead of [string length] for less shimmer risk. --- library/tm.tcl | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/library/tm.tcl b/library/tm.tcl index 955e84d..55efda6 100644 --- a/library/tm.tcl +++ b/library/tm.tcl @@ -238,7 +238,7 @@ proc ::tcl::tm::UnknownHandler {original name args} { continue } - if {[string length [package ifneeded $pkgname $pkgversion]]} { + if {[package ifneeded $pkgname $pkgversion] ne {}} { # There's already a provide script registered for # this version of this package. Since all units of # code claiming to be the same version of the same -- cgit v0.12 From 76023565adb6e64816efbf4cae39b1c5d2ab725a Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 5 Sep 2013 17:21:41 +0000 Subject: Partial revert of [a16752c252] bug fix to stop crashes in buggy tclcompiler. --- generic/tclBasic.c | 24 ++++++++++++++++++++++-- 1 file changed, 22 insertions(+), 2 deletions(-) diff --git a/generic/tclBasic.c b/generic/tclBasic.c index 314b5fc..c3ab871 100644 --- a/generic/tclBasic.c +++ b/generic/tclBasic.c @@ -1967,7 +1967,8 @@ Tcl_CreateCommand( * * Side effects: * If a command named "cmdName" already exists for interp, it is - * first deleted. Then the new command is created from the arguments. + * first deleted. Then the new command is created from the arguments. + * [***] (See below for exception). * * In the future, during bytecode evaluation when "cmdName" is seen as * the name of a command by Tcl_EvalObj or Tcl_Eval, the object-based @@ -2034,8 +2035,27 @@ Tcl_CreateObjCommand( if (!isNew) { cmdPtr = Tcl_GetHashValue(hPtr); + /* Command already exists. */ + + /* + * [***] This is wrong. See Tcl Bug a16752c252. + * However, this buggy behavior is kept under particular + * circumstances to accommodate deployed binaries of the + * "tclcompiler" program. http://sourceforge.net/projects/tclpro/ + * that crash if the bug is fixed. + */ + + if (cmdPtr->objProc == TclInvokeStringCommand + && cmdPtr->clientData == clientData + && cmdPtr->deleteData == clientData + && cmdPtr->deleteProc == deleteProc) { + cmdPtr->objProc = proc; + cmdPtr->objClientData = clientData; + return (Tcl_Command) cmdPtr; + } + /* - * Command already exists; delete it. Be careful to preserve any + * Otherwise, we delete the old command. 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. -- cgit v0.12 From 991ddbd26c7c24de6598ff9fe61a1d9f13186548 Mon Sep 17 00:00:00 2001 From: dkf Date: Sun, 8 Sep 2013 10:21:37 +0000 Subject: [3611643] Stop polluting the global namespace. Refactor the index entry generation so it is done right, once. Handle more of [namespace ensemble create]'s behavior. --- library/auto.tcl | 69 +++++++++++++++++++++++++++++++++++--------------------- 1 file changed, 43 insertions(+), 26 deletions(-) diff --git a/library/auto.tcl b/library/auto.tcl index 78c219e..02edcc4 100644 --- a/library/auto.tcl +++ b/library/auto.tcl @@ -513,6 +513,32 @@ proc auto_mkindex_parser::fullname {name} { return [string map [list \0 \$] $name] } +# auto_mkindex_parser::indexEntry -- +# +# Used by commands like "proc" within the auto_mkindex parser to add a +# correctly-quoted entry to the index. This is shared code so it is done +# *right*, in one place. +# +# Arguments: +# name - Name that is being added to index. + +proc auto_mkindex_parser::indexEntry {name} { + variable index + variable scriptFile + + # We convert all metacharacters to their backslashed form, and pre-split + # the file name that we know about (which will be a proper list, and so + # correctly quoted). + + set name [string range [list \}[fullname $name]] 2 end] + set filenameParts [file split $scriptFile] + + append index [format \ + {set auto_index(%s) [list source [file join $dir %s]]%s} \ + $name $filenameParts \n] + return +} + if {[llength $::auto_mkindex_parser::initCommands]} { return } @@ -524,15 +550,7 @@ if {[llength $::auto_mkindex_parser::initCommands]} { # Adds an entry to the auto index list for the given procedure name. auto_mkindex_parser::command proc {name args} { - variable index - variable scriptFile - # Do some fancy reformatting on the "source" call to handle platform - # differences with respect to pathnames. Use format just so that the - # command is a little easier to read (otherwise it'd be full of - # backslashed dollar signs, etc. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } # Conditionally add support for Tcl byte code files. There are some tricky @@ -559,14 +577,7 @@ auto_mkindex_parser::hook { # procedure name. auto_mkindex_parser::commandInit tbcload::bcproc {name args} { - variable index - variable scriptFile - # Do some nice reformatting of the "source" call, to get around - # path differences on different platforms. We use the format - # command just so that the code is a little easier to read. - append index [list set auto_index([fullname $name])] \ - [format { [list source [file join $dir %s]]} \ - [file split $scriptFile]] "\n" + indexEntry $name } } } @@ -610,6 +621,13 @@ auto_mkindex_parser::command namespace {op args} { variable contextStack if {[lindex $args 0] eq "create"} { set name ::[join [lreverse $contextStack] ::] + catch { + set name [dict get [lrange $args 1 end] -command] + if {![string match ::* $name]} { + set name ::[join [lreverse $contextStack] ::]$name + } + regsub -all ::+ $name :: name + } # create artifical proc to force an entry in the tclIndex $parser eval [list ::proc $name {} {}] } @@ -619,15 +637,14 @@ auto_mkindex_parser::command namespace {op args} { # AUTO MKINDEX: oo::class create name ?definition? # Adds an entry to the auto index list for the given class name. -foreach cmd {oo::class class} { - auto_mkindex_parser::command $cmd {ecmd name {body ""}} { - if {$cmd eq "create"} { - variable index - variable scriptFile - append index [format "set %s \[list source \[%s]]\n" \ - [list auto_index([fullname $name])] \ - [list file join $dir {*}[file split $scriptFile]]] - } +auto_mkindex_parser::command oo::class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name + } +} +auto_mkindex_parser::command class {op name {body ""}} { + if {$op eq "create"} { + indexEntry $name } } -- cgit v0.12 From 6652de82ba5502a042b2be29a5cf7e04b73fca4b Mon Sep 17 00:00:00 2001 From: dkf Date: Mon, 9 Sep 2013 13:34:06 +0000 Subject: [3609693] Must strip the internal representation of procedure-like methods in order to ensure that any bound references to instance variables are removed. --- generic/tclOOMethod.c | 50 ++++++++++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 48 insertions(+), 2 deletions(-) diff --git a/generic/tclOOMethod.c b/generic/tclOOMethod.c index 81293c7..61215de 100644 --- a/generic/tclOOMethod.c +++ b/generic/tclOOMethod.c @@ -1290,11 +1290,57 @@ CloneProcedureMethod( ClientData *newClientData) { ProcedureMethod *pmPtr = clientData; - ProcedureMethod *pm2Ptr = ckalloc(sizeof(ProcedureMethod)); + ProcedureMethod *pm2Ptr; + Tcl_Obj *bodyObj, *argsObj; + CompiledLocal *localPtr; + /* + * Copy the argument list. + */ + + argsObj = Tcl_NewObj(); + for (localPtr=pmPtr->procPtr->firstLocalPtr; localPtr!=NULL; + localPtr=localPtr->nextPtr) { + if (TclIsVarArgument(localPtr)) { + Tcl_Obj *argObj = Tcl_NewObj(); + + Tcl_ListObjAppendElement(NULL, argObj, + Tcl_NewStringObj(localPtr->name, -1)); + if (localPtr->defValuePtr != NULL) { + Tcl_ListObjAppendElement(NULL, argObj, localPtr->defValuePtr); + } + Tcl_ListObjAppendElement(NULL, argsObj, argObj); + } + } + + /* + * Must strip the internal representation in order to ensure that any + * bound references to instance variables are removed. [Bug 3609693] + */ + + bodyObj = Tcl_DuplicateObj(pmPtr->procPtr->bodyPtr); + TclFreeIntRep(bodyObj); + + /* + * Create the actual copy of the method record, manufacturing a new proc + * record. + */ + + pm2Ptr = ckalloc(sizeof(ProcedureMethod)); memcpy(pm2Ptr, pmPtr, sizeof(ProcedureMethod)); pm2Ptr->refCount = 1; - pm2Ptr->procPtr->refCount++; + Tcl_IncrRefCount(argsObj); + Tcl_IncrRefCount(bodyObj); + if (TclCreateProc(interp, NULL, "", argsObj, bodyObj, + &pm2Ptr->procPtr) != TCL_OK) { + Tcl_DecrRefCount(argsObj); + Tcl_DecrRefCount(bodyObj); + ckfree(pm2Ptr); + return TCL_ERROR; + } + Tcl_DecrRefCount(argsObj); + Tcl_DecrRefCount(bodyObj); + if (pmPtr->cloneClientdataProc) { pm2Ptr->clientData = pmPtr->cloneClientdataProc(pmPtr->clientData); } -- cgit v0.12 From 28bb618586416fbb3c1c9a710cf88e5f8d924025 Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 Sep 2013 02:32:04 +0000 Subject: Stop the save and restore of currStackDepth. Just manage it correctly so it doesn't need correcting. --- generic/tclCompExpr.c | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 2a48117..c2b5a1a 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -490,8 +490,6 @@ typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of * TclEmitForwardJump() and * TclFixupForwardJump(). */ - int depth; /* Remember the currStackDepth of the - * CompileEnv here. */ int offset; /* Data used to compute jump lengths to pass * to TclFixupForwardJump() */ int convert; /* Temporary storage used to compute whether @@ -2269,7 +2267,6 @@ CompileExprTree( newJump = TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; convert = 1; break; case AND: @@ -2283,7 +2280,6 @@ CompileExprTree( newJump = TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - jumpPtr->depth = envPtr->currStackDepth; break; } } else if (nodePtr->mark == MARK_RIGHT) { @@ -2323,7 +2319,7 @@ CompileExprTree( CLANG_ASSERT(jumpPtr); TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->next->jump); - envPtr->currStackDepth = jumpPtr->depth; + TclAdjustStackDepth(-1, envPtr); jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); jumpPtr->convert = convert; convert = 1; @@ -2383,7 +2379,6 @@ CompileExprTree( TclFixupForwardJump(envPtr, &jumpPtr->jump, jumpPtr->offset - jumpPtr->jump.codeOffset, 127); convert |= jumpPtr->convert; - envPtr->currStackDepth = jumpPtr->depth + 1; freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); @@ -2411,7 +2406,6 @@ CompileExprTree( TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump, 127); convert = 0; - envPtr->currStackDepth = jumpPtr->depth + 1; freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); -- cgit v0.12 From 7eabd2838a8210a30da24672179294fd7d8b1b0a Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 Sep 2013 04:49:08 +0000 Subject: Make use of the existing JumpFixup fields. Eliminate extra storage field 'offset' in JumpList that we don't require. --- generic/tclCompExpr.c | 7 ++----- 1 file changed, 2 insertions(+), 5 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index c2b5a1a..0021323 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -490,8 +490,6 @@ typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of * TclEmitForwardJump() and * TclFixupForwardJump(). */ - int offset; /* Data used to compute jump lengths to pass - * to TclFixupForwardJump() */ int convert; /* Temporary storage used to compute whether * numeric conversion will be needed following * the operator we're compiling. */ @@ -2320,7 +2318,6 @@ CompileExprTree( TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->next->jump); TclAdjustStackDepth(-1, envPtr); - jumpPtr->offset = (envPtr->codeNext - envPtr->codeStart); jumpPtr->convert = convert; convert = 1; break; @@ -2374,10 +2371,10 @@ CompileExprTree( if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump, (envPtr->codeNext - envPtr->codeStart) - jumpPtr->next->jump.codeOffset, 127)) { - jumpPtr->offset += 3; + jumpPtr->next->jump.codeOffset += 3; } TclFixupForwardJump(envPtr, &jumpPtr->jump, - jumpPtr->offset - jumpPtr->jump.codeOffset, 127); + jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127); convert |= jumpPtr->convert; freePtr = jumpPtr; jumpPtr = jumpPtr->next; -- cgit v0.12 From 23bb5a2c20bd07e4b66ad4293fb927128e9e975b Mon Sep 17 00:00:00 2001 From: dgp Date: Wed, 11 Sep 2013 05:07:52 +0000 Subject: Eliminate another surplus storage field. Make a(n ab)use of the existing JumpFixup fields instead. --- generic/tclCompExpr.c | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 0021323..4afb069 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -490,9 +490,6 @@ typedef struct JumpList { JumpFixup jump; /* Pass this argument to matching calls of * TclEmitForwardJump() and * TclFixupForwardJump(). */ - int convert; /* Temporary storage used to compute whether - * numeric conversion will be needed following - * the operator we're compiling. */ struct JumpList *next; /* Point to next item on the stack */ } JumpList; @@ -2318,7 +2315,9 @@ CompileExprTree( TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, &jumpPtr->next->jump); TclAdjustStackDepth(-1, envPtr); - jumpPtr->convert = convert; + if (convert) { + jumpPtr->jump.jumpType = TCL_TRUE_JUMP; + } convert = 1; break; case AND: @@ -2368,6 +2367,10 @@ CompileExprTree( break; case COLON: CLANG_ASSERT(jumpPtr); + if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) { + jumpPtr->jump.jumpType = TCL_FALSE_JUMP; + convert = 1; + } if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump, (envPtr->codeNext - envPtr->codeStart) - jumpPtr->next->jump.codeOffset, 127)) { @@ -2375,7 +2378,6 @@ CompileExprTree( } TclFixupForwardJump(envPtr, &jumpPtr->jump, jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127); - convert |= jumpPtr->convert; freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); -- cgit v0.12 From 3e3fe2606ae5233ae213b95fd91d7d05d2987659 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 Sep 2013 17:42:36 +0000 Subject: Stop allocating JumpFixups for jumps that can never need any fixing up. --- generic/tclCompExpr.c | 37 +++++++++++++++---------------------- 1 file changed, 15 insertions(+), 22 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 4afb069..7684c70 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2269,12 +2269,6 @@ CompileExprTree( newJump = TclStackAlloc(interp, sizeof(JumpList)); newJump->next = jumpPtr; jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; break; } } else if (nodePtr->mark == MARK_RIGHT) { @@ -2328,6 +2322,8 @@ CompileExprTree( break; } } else { + int pc1, pc2; + switch (nodePtr->lexeme) { case START: case QUESTION: @@ -2377,7 +2373,9 @@ CompileExprTree( jumpPtr->next->jump.codeOffset += 3; } TclFixupForwardJump(envPtr, &jumpPtr->jump, - jumpPtr->next->jump.codeOffset + 2 -jumpPtr->jump.codeOffset, 127); + jumpPtr->next->jump.codeOffset + 2 + - jumpPtr->jump.codeOffset, 127); + freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); @@ -2388,32 +2386,27 @@ CompileExprTree( case AND: case OR: CLANG_ASSERT(jumpPtr); - TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) - ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, - &jumpPtr->next->jump); + pc1 = CurrentOffset(envPtr); + TclEmitInstInt1((nodePtr->lexeme == AND) ? INST_JUMP_FALSE1 + : INST_JUMP_TRUE1, 0, envPtr); TclEmitPush(TclRegisterNewLiteral(envPtr, (nodePtr->lexeme == AND) ? "1" : "0", 1), envPtr); - TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &jumpPtr->next->next->jump); + pc2 = CurrentOffset(envPtr); + TclEmitInstInt1(INST_JUMP1, 0, envPtr); TclAdjustStackDepth(-1, envPtr); - TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->jump, 127); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc1, + envPtr->codeStart + pc1 + 1); if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { - jumpPtr->next->next->jump.codeOffset += 3; + pc2 += 3; } TclEmitPush(TclRegisterNewLiteral(envPtr, (nodePtr->lexeme == AND) ? "0" : "1", 1), envPtr); - TclFixupForwardJumpToHere(envPtr, &jumpPtr->next->next->jump, - 127); + TclStoreInt1AtPtr(CurrentOffset(envPtr) - pc2, + envPtr->codeStart + pc2 + 1); convert = 0; freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); - freePtr = jumpPtr; - jumpPtr = jumpPtr->next; - TclStackFree(interp, freePtr); break; default: TclEmitOpcode(instruction[nodePtr->lexeme], envPtr); -- cgit v0.12 From c12159563db8f0ecce0a00351e1cb0caed2a7acc Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 Sep 2013 19:21:20 +0000 Subject: Swap the two fixups used when compiling the ternary operator. Push them on the stack only when needed, and pop as soon as possible. --- generic/tclCompExpr.c | 33 ++++++++++++++++----------------- 1 file changed, 16 insertions(+), 17 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 7684c70..106855a 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2256,12 +2256,6 @@ CompileExprTree( switch (nodePtr->lexeme) { case QUESTION: - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; convert = 1; break; case AND: @@ -2302,12 +2296,17 @@ CompileExprTree( break; } case QUESTION: + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); break; case COLON: - CLANG_ASSERT(jumpPtr); + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; TclEmitForwardJump(envPtr, TCL_UNCONDITIONAL_JUMP, - &jumpPtr->next->jump); + &jumpPtr->jump); TclAdjustStackDepth(-1, envPtr); if (convert) { jumpPtr->jump.jumpType = TCL_TRUE_JUMP; @@ -2322,7 +2321,7 @@ CompileExprTree( break; } } else { - int pc1, pc2; + int pc1, pc2, target; switch (nodePtr->lexeme) { case START: @@ -2364,21 +2363,21 @@ CompileExprTree( case COLON: CLANG_ASSERT(jumpPtr); if (jumpPtr->jump.jumpType == TCL_TRUE_JUMP) { - jumpPtr->jump.jumpType = TCL_FALSE_JUMP; + jumpPtr->jump.jumpType = TCL_UNCONDITIONAL_JUMP; convert = 1; } - if (TclFixupForwardJump(envPtr, &jumpPtr->next->jump, + target = jumpPtr->jump.codeOffset + 2; + if (TclFixupForwardJump(envPtr, &jumpPtr->jump, (envPtr->codeNext - envPtr->codeStart) - - jumpPtr->next->jump.codeOffset, 127)) { - jumpPtr->next->jump.codeOffset += 3; + - jumpPtr->jump.codeOffset, 127)) { + target += 3; } - TclFixupForwardJump(envPtr, &jumpPtr->jump, - jumpPtr->next->jump.codeOffset + 2 - - jumpPtr->jump.codeOffset, 127); - freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); + TclFixupForwardJump(envPtr, &jumpPtr->jump, + target - jumpPtr->jump.codeOffset, 127); + freePtr = jumpPtr; jumpPtr = jumpPtr->next; TclStackFree(interp, freePtr); -- cgit v0.12 From c34e729136c3608344a630fc086235da2a4092e4 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 12 Sep 2013 19:27:48 +0000 Subject: Push fixup on the stack only when needed. --- generic/tclCompExpr.c | 18 ++++++------------ 1 file changed, 6 insertions(+), 12 deletions(-) diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index 106855a..fce870b 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2254,16 +2254,8 @@ CompileExprTree( if (nodePtr->mark == MARK_LEFT) { next = nodePtr->left; - switch (nodePtr->lexeme) { - case QUESTION: + if (nodePtr->lexeme == QUESTION) { convert = 1; - break; - case AND: - case OR: - newJump = TclStackAlloc(interp, sizeof(JumpList)); - newJump->next = jumpPtr; - jumpPtr = newJump; - break; } } else if (nodePtr->mark == MARK_RIGHT) { next = nodePtr->right; @@ -2314,10 +2306,12 @@ CompileExprTree( convert = 1; break; case AND: - TclEmitForwardJump(envPtr, TCL_FALSE_JUMP, &jumpPtr->jump); - break; case OR: - TclEmitForwardJump(envPtr, TCL_TRUE_JUMP, &jumpPtr->jump); + newJump = TclStackAlloc(interp, sizeof(JumpList)); + newJump->next = jumpPtr; + jumpPtr = newJump; + TclEmitForwardJump(envPtr, (nodePtr->lexeme == AND) + ? TCL_FALSE_JUMP : TCL_TRUE_JUMP, &jumpPtr->jump); break; } } else { -- cgit v0.12 From 6fef99593ff6cf1e4f504ca2a9ddabbd0d17c04b Mon Sep 17 00:00:00 2001 From: dgp Date: Fri, 13 Sep 2013 03:33:43 +0000 Subject: More macro use. --- generic/tclCompCmds.c | 8 ++------ generic/tclCompExpr.c | 4 +--- 2 files changed, 3 insertions(+), 9 deletions(-) diff --git a/generic/tclCompCmds.c b/generic/tclCompCmds.c index 8edb2d9..fdc8ec1 100644 --- a/generic/tclCompCmds.c +++ b/generic/tclCompCmds.c @@ -2228,7 +2228,7 @@ TclCompileForCmd( { Tcl_Token *startTokenPtr, *testTokenPtr, *nextTokenPtr, *bodyTokenPtr; JumpFixup jumpEvalCondFixup; - int testCodeOffset, bodyCodeOffset, nextCodeOffset, jumpDist; + int bodyCodeOffset, nextCodeOffset, jumpDist; int bodyRange, nextRange; DefineLineInformation; /* TIP #280 */ @@ -2309,13 +2309,9 @@ TclCompileForCmd( * terminates the for. */ - testCodeOffset = CurrentOffset(envPtr); - - jumpDist = testCodeOffset - jumpEvalCondFixup.codeOffset; - if (TclFixupForwardJump(envPtr, &jumpEvalCondFixup, jumpDist, 127)) { + if (TclFixupForwardJumpToHere(envPtr, &jumpEvalCondFixup, 127)) { bodyCodeOffset += 3; nextCodeOffset += 3; - testCodeOffset += 3; } SetLineInformation(2); diff --git a/generic/tclCompExpr.c b/generic/tclCompExpr.c index fce870b..d8e4d9f 100644 --- a/generic/tclCompExpr.c +++ b/generic/tclCompExpr.c @@ -2361,9 +2361,7 @@ CompileExprTree( convert = 1; } target = jumpPtr->jump.codeOffset + 2; - if (TclFixupForwardJump(envPtr, &jumpPtr->jump, - (envPtr->codeNext - envPtr->codeStart) - - jumpPtr->jump.codeOffset, 127)) { + if (TclFixupForwardJumpToHere(envPtr, &jumpPtr->jump, 127)) { target += 3; } freePtr = jumpPtr; -- cgit v0.12 From 878be345c1b4a3fbf9756a06985a1b2ce306bd57 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 13 Sep 2013 10:53:32 +0000 Subject: Suggested fix for [bdd91c7e43]: tclsh crashes in [interp delete] --- generic/tclExecute.c | 1 + unix/configure | 0 2 files changed, 1 insertion(+) mode change 100755 => 100644 unix/configure diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 8fb8e63..e657828 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -2311,6 +2311,7 @@ TclExecuteByteCode( initCatchTop += moved; catchTop += moved; + bcFramePtr = (CmdFrame *) (initCatchTop + codePtr->maxExceptDepth + 1); initTosPtr += moved; tosPtr += moved; esPtr = iPtr->execEnvPtr->execStackPtr; diff --git a/unix/configure b/unix/configure old mode 100755 new mode 100644 -- cgit v0.12