From a5cfbafa9098e5ae4018b3142702fd8138417776 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 17 Jan 2013 13:29:07 +0000 Subject: Proposed fix, by kakaroto, for Bug 2911139: http::geturl abuses vwait on async call --- library/http/http.tcl | 64 ++++++++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 31 deletions(-) diff --git a/library/http/http.tcl b/library/http/http.tcl index 6b82894..4a517ac 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -528,11 +528,10 @@ proc http::geturl {url args} { # If a timeout is specified we set up the after event and arrange for an # asynchronous socket connection. - set sockopts [list] + set sockopts [list -async] if {$state(-timeout) > 0} { set state(after) [after $state(-timeout) \ [list http::reset $token timeout]] - lappend sockopts -async } # If we are using the proxy, we must pass in the full URL that includes @@ -588,10 +587,15 @@ proc http::geturl {url args} { set socketmap($state(socketinfo)) $sock } - # Wait for the connection to complete. + if {![info exists phost]} { + set phost "" + } + fileevent $sock writable [list http::Connect $token $proto $phost $srvurl] - if {$state(-timeout) > 0} { - fileevent $sock writable [list http::Connect $token] + # Wait for the connection to complete. + if {![info exists state(-command)]} { + # geturl does EVERYTHING asynchronously, so if the user + # calls it synchronously, we just do a wait here. http::wait $token if {![info exists state]} { @@ -607,13 +611,29 @@ proc http::geturl {url args} { set err [lindex $state(error) 0] cleanup $token return -code error $err - } elseif {$state(status) ne "connect"} { - # Likely to be connection timeout - return $token } - set state(status) "" } + return $token +} + + +proc http::Connected { token proto phost srvurl} { + variable http + variable urlTypes + + variable $token + upvar 0 $token state + + # Set back the variables needed here + set sock $state(sock) + set isQueryChannel [info exists state(-querychannel)] + set isQuery [info exists state(-query)] + set host [lindex [split $state(socketinfo) :] 0] + set port [lindex [split $state(socketinfo) :] 1] + + set defport [lindex $urlTypes($proto) 0] + # Send data in cr-lf format, but accept any line terminators fconfigure $sock -translation {auto crlf} -buffersize $state(-blocksize) @@ -746,35 +766,17 @@ proc http::geturl {url args} { fileevent $sock readable [list http::Event $sock $token] } - if {![info exists state(-command)]} { - # geturl does EVERYTHING asynchronously, so if the user calls it - # synchronously, we just do a wait here. - - wait $token - if {$state(status) eq "error"} { - # Something went wrong, so throw the exception, and the - # enclosing catch will do cleanup. - return -code error [lindex $state(error) 0] - } - } } err]} then { # The socket probably was never connected, or the connection dropped # later. - # Clean up after events and such, but DON'T call the command callback - # (if available) because we're going to throw an exception from here - # instead. - # if state(status) is error, it means someone's already called Finish # to do the above-described clean up. if {$state(status) ne "error"} { - Finish $token $err 1 + Finish $token $err } - cleanup $token - return -code error $err } - return $token } # Data access functions: @@ -858,7 +860,7 @@ proc http::cleanup {token} { # Sets the status of the connection, which unblocks # the waiting geturl call -proc http::Connect {token} { +proc http::Connect {token proto phost srvurl} { variable $token upvar 0 $token state set err "due to unexpected EOF" @@ -866,10 +868,10 @@ proc http::Connect {token} { [eof $state(sock)] || [set err [fconfigure $state(sock) -error]] ne "" } then { - Finish $token "connect failed $err" 1 + Finish $token "connect failed $err" } else { - set state(status) connect fileevent $state(sock) writable {} + ::http::Connected $token $proto $phost $srvurl } return } -- cgit v0.12 From 0389d9d276a16e5f11a8ec823cb2334e4b5d119a Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Jan 2013 08:16:44 +0000 Subject: Fix test-case http-4.14 --- tests/http.test | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/tests/http.test b/tests/http.test index 3a9d4ba..b03df88 100644 --- a/tests/http.test +++ b/tests/http.test @@ -465,8 +465,7 @@ test http-4.14 {http::Event} -body { } http::wait $token http::status $token - # error code varies among platforms. -} -returnCodes 1 -match regexp -result {(connect failed|couldn't open socket)} +} -result {timeout} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be -- cgit v0.12 From 21be09ba34563c7d9fd3b0d013fe643c63f00174 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Jan 2013 21:56:27 +0000 Subject: Bug [3601804]: platformCPUID segmentation fault on Darwin --- unix/tclUnixCompat.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 71bd846..1969d1c 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -698,7 +698,7 @@ TclWinCPUID( "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */ "mov %%edi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index) : "edi"); + : "a"(index) : "edi","ebx"); status = TCL_OK; #endif return status; -- cgit v0.12 From ae2b9cd377978ef7018b95e2d16b17042e2eb76b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Tue, 22 Jan 2013 22:53:26 +0000 Subject: Now really fix test-case http-4.14 --- tests/http.test | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/tests/http.test b/tests/http.test index b03df88..3ec0a6f 100644 --- a/tests/http.test +++ b/tests/http.test @@ -464,8 +464,8 @@ test http-4.14 {http::Event} -body { error "bogus return from http::geturl" } http::wait $token - http::status $token -} -result {timeout} + lindex [http::error $token] 0 +} -result {connect failed connection refused} # Bogus host test http-4.15 {http::Event} -body { # This test may fail if you use a proxy server. That is to be -- cgit v0.12 From c58c25ef079a96e684e2be9bdf78040c84c3cf9b Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Wed, 23 Jan 2013 13:57:30 +0000 Subject: Protect Tcl_GetIndexFromObjStruct from invalid "offset" values, like 0 or -1. Undocumented, because I don't want to promote people start using that. --- generic/tclIndexObj.c | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/generic/tclIndexObj.c b/generic/tclIndexObj.c index cc50fd3..0103cdb 100644 --- a/generic/tclIndexObj.c +++ b/generic/tclIndexObj.c @@ -144,7 +144,7 @@ Tcl_GetIndexFromObj(interp, objPtr, tablePtr, msg, flags, indexPtr) * returned and an error message is left in interp's result (unless * interp is NULL). The msg argument is used in the error * message; for example, if msg has the value "option" then the - * error message will say something flag 'bad option "foo": must be + * error message will say something like 'bad option "foo": must be * ...' * * Side effects: @@ -176,6 +176,10 @@ Tcl_GetIndexFromObjStruct(interp, objPtr, tablePtr, offset, msg, flags, Tcl_Obj *resultPtr; IndexRep *indexRep; + /* Protect against invalid values, like -1 or 0. */ + if (offset < (int)sizeof(char *)) { + offset = (int)sizeof(char *); + } /* * See if there is a valid cached result from a previous lookup. */ -- cgit v0.12 From 94605ca2706bce3bfe127eb4168ca135fd02b609 Mon Sep 17 00:00:00 2001 From: dgp Date: Thu, 24 Jan 2013 18:47:18 +0000 Subject: Silence some compiler warnings. --- generic/tclCkalloc.c | 4 ++++ generic/tclExecute.c | 3 +++ generic/tclFileName.c | 4 ++++ 3 files changed, 11 insertions(+) diff --git a/generic/tclCkalloc.c b/generic/tclCkalloc.c index a9d98ec..6de9720 100644 --- a/generic/tclCkalloc.c +++ b/generic/tclCkalloc.c @@ -149,6 +149,10 @@ TclInitDbCkalloc() if (!ckallocInit) { ckallocInit = 1; ckallocMutexPtr = Tcl_GetAllocMutex(); +#ifndef TCL_THREADS + /* Silence compiler warning */ + (void)ckallocMutexPtr; +#endif } } diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 2a9f8bb..c09b73e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -5118,6 +5118,9 @@ VerifyExprObjType(interp, objPtr) long i; Tcl_WideInt w; GET_WIDE_OR_INT(result, objPtr, i, w); + /* Quiet cranky old compilers that complain about + * setting i, but not using it. */ + (void)i; } else { double d; result = Tcl_GetDoubleFromObj((Tcl_Interp *) NULL, objPtr, &d); diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 046eaef..bcaadd4 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1784,13 +1784,17 @@ TclDoGlob(interp, separators, headPtr, tail, types) int baseLength, quoted, count; int result = TCL_OK; char *name, *p, *openBrace, *closeBrace, *firstSpecialChar, savedChar; + /* char lastChar = 0; + */ int length = Tcl_DStringLength(headPtr); + /* if (length > 0) { lastChar = Tcl_DStringValue(headPtr)[length-1]; } + */ /* * Consume any leading directory separators, leaving tail pointing -- cgit v0.12 From 8d7d6d8cfd4c9f0670d5c20f115e9a69364f3cef Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 Jan 2013 21:28:43 +0000 Subject: revert [273bbe926d]: it doesn't work on i386 --- unix/tclUnixCompat.c | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 1969d1c..71bd846 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -698,7 +698,7 @@ TclWinCPUID( "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */ "mov %%edi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index) : "edi","ebx"); + : "a"(index) : "edi"); status = TCL_OK; #endif return status; -- cgit v0.12 From 2ad8238512c29b86039ba28d5e489ffd77069793 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Thu, 24 Jan 2013 22:00:50 +0000 Subject: new version of cpuid, which doesn't use the edi register any more. Hopefully that works better on some Darwin. --- unix/tclUnixCompat.c | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/unix/tclUnixCompat.c b/unix/tclUnixCompat.c index 71bd846..5a3ccd4 100644 --- a/unix/tclUnixCompat.c +++ b/unix/tclUnixCompat.c @@ -693,12 +693,11 @@ TclWinCPUID( /* See: */ #if defined(HAVE_CPUID) - __asm__ __volatile__("mov %%ebx, %%edi \n\t" /* save %ebx */ + __asm__ __volatile__("mov %%ebx, %%esi \n\t" /* save %ebx */ "cpuid \n\t" - "mov %%ebx, %%esi \n\t" /* save what cpuid just put in %ebx */ - "mov %%edi, %%ebx \n\t" /* restore the old %ebx */ + "xchg %%esi, %%ebx \n\t" /* restore the old %ebx */ : "=a"(regsPtr[0]), "=S"(regsPtr[1]), "=c"(regsPtr[2]), "=d"(regsPtr[3]) - : "a"(index) : "edi"); + : "a"(index)); status = TCL_OK; #endif return status; -- cgit v0.12 From 1a19e1f67d4039692837657d71be3d35b40a9662 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Jan 2013 11:48:29 +0000 Subject: Eliminate some unneeded usages of Tcl_SetResult, Tcl_AddObjErrorInfo Fix "make test-packages" on cygwin --- generic/tclAssembly.c | 9 ++++----- generic/tclEnsemble.c | 2 +- generic/tclExecute.c | 4 ++-- generic/tclOO.c | 2 +- generic/tclResult.c | 2 +- generic/tclThreadTest.c | 2 +- generic/tclTrace.c | 2 +- generic/tclVar.c | 4 ++-- unix/Makefile.in | 2 +- unix/tclUnixTest.c | 10 +++++----- win/tclWinTest.c | 2 +- 11 files changed, 20 insertions(+), 21 deletions(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 7833105..99bdf43 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -798,12 +798,11 @@ TclNRAssembleObjCmd( if (codePtr == NULL) { Tcl_AddErrorInfo(interp, "\n (\""); - Tcl_AddErrorInfo(interp, Tcl_GetString(objv[0])); + Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp)); Tcl_IncrRefCount(backtrace); - Tcl_AddErrorInfo(interp, Tcl_GetString(backtrace)); - Tcl_DecrRefCount(backtrace); + Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; } @@ -4270,11 +4269,11 @@ AddBasicBlockRangeToErrorInfo( Tcl_AddErrorInfo(interp, "\n in assembly code between lines "); lineNo = Tcl_NewIntObj(bbPtr->startLine); Tcl_IncrRefCount(lineNo); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); Tcl_AddErrorInfo(interp, " and "); if (bbPtr->successor1 != NULL) { Tcl_SetIntObj(lineNo, bbPtr->successor1->startLine); - Tcl_AddErrorInfo(interp, Tcl_GetString(lineNo)); + Tcl_AppendObjToErrorInfo(interp, lineNo); } else { Tcl_AddErrorInfo(interp, "end of assembly code"); } diff --git a/generic/tclEnsemble.c b/generic/tclEnsemble.c index 88de9f3..f392cad 100644 --- a/generic/tclEnsemble.c +++ b/generic/tclEnsemble.c @@ -2196,7 +2196,7 @@ EnsembleUnknownCallback( } Tcl_AddErrorInfo(interp, "\n result of " "ensemble unknown subcommand handler: "); - Tcl_AddErrorInfo(interp, TclGetString(unknownCmd)); + Tcl_AppendObjToErrorInfo(interp, unknownCmd); Tcl_SetErrorCode(interp, "TCL", "ENSEMBLE", "UNKNOWN_RESULT", NULL); } else { diff --git a/generic/tclExecute.c b/generic/tclExecute.c index 978d026..c2cef2a 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -3464,8 +3464,8 @@ TEBCresume( varPtr = TclObjLookupVarEx(interp, objPtr, part2Ptr, TCL_LEAVE_ERR_MSG, "read", 1, 1, &arrayPtr); if (!varPtr) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); TRACE_APPEND(("ERROR: %.30s\n", O2S(Tcl_GetObjResult(interp)))); Tcl_DecrRefCount(incrPtr); goto gotError; diff --git a/generic/tclOO.c b/generic/tclOO.c index d6d2d6a..cb22de6 100644 --- a/generic/tclOO.c +++ b/generic/tclOO.c @@ -843,7 +843,7 @@ ObjectRenamedTrace( result = Tcl_NRCallObjProc(interp, TclOOInvokeContext, contextPtr, 0, NULL); if (result != TCL_OK) { - Tcl_BackgroundError(interp); + Tcl_BackgroundException(interp, result); } Tcl_RestoreInterpState(interp, state); TclOODeleteContext(contextPtr); diff --git a/generic/tclResult.c b/generic/tclResult.c index 9707f20..07f6819 100644 --- a/generic/tclResult.c +++ b/generic/tclResult.c @@ -1587,7 +1587,7 @@ Tcl_GetReturnOptions( } if (result == TCL_ERROR) { - Tcl_AddObjErrorInfo(interp, "", -1); + Tcl_AddErrorInfo(interp, ""); Tcl_DictObjPut(NULL, options, keys[KEY_ERRORSTACK], iPtr->errorStack); } if (iPtr->errorCode) { diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index b90e33d..1115ff0 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -926,7 +926,7 @@ ThreadSend( ckfree(resultPtr->errorInfo); } } - Tcl_SetResult(interp, resultPtr->result, TCL_DYNAMIC); + Tcl_AppendResult(interp, resultPtr->result, NULL); Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; diff --git a/generic/tclTrace.c b/generic/tclTrace.c index 519f201..0f297a4 100644 --- a/generic/tclTrace.c +++ b/generic/tclTrace.c @@ -1322,7 +1322,7 @@ TraceCommandProc( Tcl_DStringLength(&cmd), 0); if (code != TCL_OK) { /* We ignore errors in these traced commands */ - /*** QUESTION: Use Tcl_BackgroundError(interp); instead? ***/ + /*** QUESTION: Use Tcl_BackgroundException(interp, code); instead? ***/ } Tcl_DStringFree(&cmd); } diff --git a/generic/tclVar.c b/generic/tclVar.c index 9b8527c..2d1479d 100644 --- a/generic/tclVar.c +++ b/generic/tclVar.c @@ -2036,8 +2036,8 @@ TclIncrObjVar2( varPtr = TclObjLookupVarEx(interp, part1Ptr, part2Ptr, flags, "read", 1, 1, &arrayPtr); if (varPtr == NULL) { - Tcl_AddObjErrorInfo(interp, - "\n (reading value of variable to increment)", -1); + Tcl_AddErrorInfo(interp, + "\n (reading value of variable to increment)"); return NULL; } return TclPtrIncrObjVar(interp, varPtr, arrayPtr, part1Ptr, part2Ptr, diff --git a/unix/Makefile.in b/unix/Makefile.in index ee31282..f8dd67c 100644 --- a/unix/Makefile.in +++ b/unix/Makefile.in @@ -1718,7 +1718,7 @@ install-packages: packages fi; \ done -test-packages: tcltest packages +test-packages: ${TCLTEST_EXE} packages @for i in $(PKGS_DIR)/*; do \ if [ -d $$i ]; then \ pkg=`basename $$i`; \ diff --git a/unix/tclUnixTest.c b/unix/tclUnixTest.c index 46fc972..c10225d 100644 --- a/unix/tclUnixTest.c +++ b/unix/tclUnixTest.c @@ -200,7 +200,7 @@ TestfilehandlerCmd( return TCL_ERROR; } sprintf(buf, "%d %d", pipePtr->readCount, pipePtr->writeCount); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "create") == 0) { if (argc != 5) { Tcl_AppendResult(interp, "wrong # arguments: should be \"", @@ -217,8 +217,8 @@ TestfilehandlerCmd( fcntl(GetFd(pipePtr->readFile), F_SETFL, O_NONBLOCK); fcntl(GetFd(pipePtr->writeFile), F_SETFL, O_NONBLOCK); #else - Tcl_SetResult(interp, "can't make pipes non-blocking", - TCL_STATIC); + Tcl_AppendResult(interp, "can't make pipes non-blocking", + NULL); return TCL_ERROR; #endif } @@ -281,7 +281,7 @@ TestfilehandlerCmd( memset(buffer, 'b', 10); TclFormatInt(buf, write(GetFd(pipePtr->writeFile), buffer, 10)); - Tcl_SetResult(interp, buf, TCL_VOLATILE); + Tcl_AppendResult(interp, buf, NULL); } else if (strcmp(argv[1], "oneevent") == 0) { Tcl_DoOneEvent(TCL_FILE_EVENTS|TCL_DONT_WAIT); } else if (strcmp(argv[1], "wait") == 0) { @@ -390,7 +390,7 @@ TestfilewaitCmd( if (Tcl_GetChannelHandle(channel, (mask & TCL_READABLE) ? TCL_READABLE : TCL_WRITABLE, (ClientData*) &data) != TCL_OK) { - Tcl_SetResult(interp, "couldn't get channel file", TCL_STATIC); + Tcl_AppendResult(interp, "couldn't get channel file", NULL); return TCL_ERROR; } fd = PTR2INT(data); diff --git a/win/tclWinTest.c b/win/tclWinTest.c index 136c4db..b83c0ba 100644 --- a/win/tclWinTest.c +++ b/win/tclWinTest.c @@ -211,7 +211,7 @@ TestvolumetypeCmd( TclWinConvertError(GetLastError()); return TCL_ERROR; } - Tcl_SetResult(interp, volType, TCL_VOLATILE); + Tcl_AppendResult(interp, volType, NULL); return TCL_OK; #undef VOL_BUF_SIZE } -- cgit v0.12 From 328fa692fbd773527e3f656e71f312717a9daed9 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Jan 2013 11:53:41 +0000 Subject: fix minor memory leak --- generic/tclAssembly.c | 1 - 1 file changed, 1 deletion(-) diff --git a/generic/tclAssembly.c b/generic/tclAssembly.c index 99bdf43..c4eeded 100644 --- a/generic/tclAssembly.c +++ b/generic/tclAssembly.c @@ -801,7 +801,6 @@ TclNRAssembleObjCmd( Tcl_AppendObjToErrorInfo(interp, objv[0]); Tcl_AddErrorInfo(interp, "\" body, line "); backtrace = Tcl_NewIntObj(Tcl_GetErrorLine(interp)); - Tcl_IncrRefCount(backtrace); Tcl_AppendObjToErrorInfo(interp, backtrace); Tcl_AddErrorInfo(interp, ")"); return TCL_ERROR; -- cgit v0.12 From 3cf091e2d8b739ba3dfaabe7e178b28abe80e00e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 25 Jan 2013 13:07:59 +0000 Subject: Another memory leak, and one Tcl_Free -> ckfree --- generic/tclThreadTest.c | 1 + unix/tclUnixTime.c | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/generic/tclThreadTest.c b/generic/tclThreadTest.c index 1115ff0..8708f9a 100644 --- a/generic/tclThreadTest.c +++ b/generic/tclThreadTest.c @@ -930,6 +930,7 @@ ThreadSend( Tcl_ConditionFinalize(&resultPtr->done); code = resultPtr->code; + ckfree(resultPtr->result); ckfree(resultPtr); return code; diff --git a/unix/tclUnixTime.c b/unix/tclUnixTime.c index c7921fe..926e8f4 100644 --- a/unix/tclUnixTime.c +++ b/unix/tclUnixTime.c @@ -503,7 +503,7 @@ SetTZIfNecessary(void) if (lastTZ == NULL) { Tcl_CreateExitHandler(CleanupMemory, NULL); } else { - Tcl_Free(lastTZ); + ckfree(lastTZ); } lastTZ = ckalloc(strlen(newTZ) + 1); strcpy(lastTZ, newTZ); -- cgit v0.12