From 0201d4b3ee5ec24ea7bb96ef5acb9d52fc65b9e7 Mon Sep 17 00:00:00 2001 From: dkf Date: Fri, 24 May 2024 19:36:08 +0000 Subject: Use TclDStringToObj a bit more --- generic/tclPkg.c | 6 +----- unix/tclUnixFCmd.c | 6 ++---- unix/tclUnixFile.c | 8 ++------ win/tclWinFCmd.c | 2 +- 4 files changed, 6 insertions(+), 16 deletions(-) diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 5e7f614..7e8db0e 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -414,11 +414,7 @@ PkgRequireCoreStep1(ClientData data[], Tcl_Interp *interp, int result) { AddRequirementsToDString(&command, reqc, reqv); Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *)reqv, NULL); - Tcl_NREvalObj(interp, - Tcl_NewStringObj(Tcl_DStringValue(&command), Tcl_DStringLength(&command)), - TCL_EVAL_GLOBAL - ); - Tcl_DStringFree(&command); + Tcl_NREvalObj(interp, TclDStringToObj(&command), TCL_EVAL_GLOBAL); } return TCL_OK; } else { diff --git a/unix/tclUnixFCmd.c b/unix/tclUnixFCmd.c index 26429df..3d44124 100644 --- a/unix/tclUnixFCmd.c +++ b/unix/tclUnixFCmd.c @@ -789,8 +789,7 @@ TclpObjCopyDirectory( Tcl_DStringFree(&dstString); if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); + *errorPtr = TclDStringToObj(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; @@ -843,8 +842,7 @@ TclpObjRemoveDirectory( Tcl_DStringFree(&pathString); if (ret != TCL_OK) { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); - Tcl_DStringFree(&ds); + *errorPtr = TclDStringToObj(&ds); Tcl_IncrRefCount(*errorPtr); } return ret; diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c index 5f9f9b3..c39e7b6 100644 --- a/unix/tclUnixFile.c +++ b/unix/tclUnixFile.c @@ -149,9 +149,7 @@ TclpFindExecutable( #endif { Tcl_ExternalToUtfDString(NULL, name, -1, &utfName); - TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), NULL); - Tcl_DStringFree(&utfName); + TclSetObjNameOfExecutable(TclDStringToObj(&utfName), NULL); goto done; } @@ -185,9 +183,7 @@ TclpFindExecutable( Tcl_DStringFree(&nameString); Tcl_ExternalToUtfDString(NULL, Tcl_DStringValue(&buffer), -1, &utfName); - TclSetObjNameOfExecutable( - Tcl_NewStringObj(Tcl_DStringValue(&utfName), -1), NULL); - Tcl_DStringFree(&utfName); + TclSetObjNameOfExecutable(TclDStringToObj(&utfName), NULL); done: Tcl_DStringFree(&buffer); diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c index 65c6441..0bf21dd 100644 --- a/win/tclWinFCmd.c +++ b/win/tclWinFCmd.c @@ -925,7 +925,7 @@ TclpObjCopyDirectory( } else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) { *errorPtr = destPathPtr; } else { - *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), -1); + *errorPtr = TclDStringToObj(&ds); } Tcl_DStringFree(&ds); Tcl_IncrRefCount(*errorPtr); -- cgit v0.12 From 1f6cd5f26d47a400a11f17b5dd17ed565bc89f2e Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Fri, 24 May 2024 22:14:08 +0000 Subject: Remove TclSetProcessGlobalValue() "encoding" parameter: it should always be NULL --- generic/tclEncoding.c | 8 ++++---- generic/tclInt.h | 2 +- generic/tclUtil.c | 13 +++++++------ 3 files changed, 12 insertions(+), 11 deletions(-) diff --git a/generic/tclEncoding.c b/generic/tclEncoding.c index 0844303..73b4f54 100644 --- a/generic/tclEncoding.c +++ b/generic/tclEncoding.c @@ -407,7 +407,7 @@ Tcl_SetEncodingSearchPath( if (TCL_ERROR == TclListObjLength(NULL, searchPath, &dummy)) { return TCL_ERROR; } - TclSetProcessGlobalValue(&encodingSearchPath, searchPath, NULL); + TclSetProcessGlobalValue(&encodingSearchPath, searchPath); return TCL_OK; } @@ -482,7 +482,7 @@ FillEncodingFileMap(void) Tcl_DecrRefCount(directory); } Tcl_DecrRefCount(searchPath); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); Tcl_DecrRefCount(map); } @@ -1778,7 +1778,7 @@ OpenEncodingFileChannel( map = Tcl_DuplicateObj(map); Tcl_DictObjRemove(NULL, map, nameObj); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); directory = NULL; } } @@ -1812,7 +1812,7 @@ OpenEncodingFileChannel( map = Tcl_DuplicateObj(TclGetProcessGlobalValue(&encodingFileMap)); Tcl_DictObjPut(NULL, map, nameObj, dir[i]); - TclSetProcessGlobalValue(&encodingFileMap, map, NULL); + TclSetProcessGlobalValue(&encodingFileMap, map); } } diff --git a/generic/tclInt.h b/generic/tclInt.h index ed8336b..938090c 100644 --- a/generic/tclInt.h +++ b/generic/tclInt.h @@ -3576,7 +3576,7 @@ MODULE_SCOPE void TclSetCmdNameObj(Tcl_Interp *interp, Tcl_Obj *objPtr, Command *cmdPtr); MODULE_SCOPE void TclSetDuplicateObj(Tcl_Obj *dupPtr, Tcl_Obj *objPtr); MODULE_SCOPE void TclSetProcessGlobalValue(ProcessGlobalValue *pgvPtr, - Tcl_Obj *newValue, Tcl_Encoding encoding); + Tcl_Obj *newValue); MODULE_SCOPE void TclSignalExitThread(Tcl_ThreadId id, int result); MODULE_SCOPE void TclSpellFix(Tcl_Interp *interp, Tcl_Obj *const *objv, Tcl_Size objc, Tcl_Size subIdx, diff --git a/generic/tclUtil.c b/generic/tclUtil.c index 0fcecbf..e2c96a9 100644 --- a/generic/tclUtil.c +++ b/generic/tclUtil.c @@ -4121,8 +4121,7 @@ FreeProcessGlobalValue( void TclSetProcessGlobalValue( ProcessGlobalValue *pgvPtr, - Tcl_Obj *newValue, - Tcl_Encoding encoding) + Tcl_Obj *newValue) { const char *bytes; Tcl_HashTable *cacheMap; @@ -4144,7 +4143,7 @@ TclSetProcessGlobalValue( } bytes = TclGetString(newValue); pgvPtr->numBytes = newValue->length; - Tcl_UtfToExternalDStringEx(NULL, encoding, bytes, pgvPtr->numBytes, + Tcl_UtfToExternalDStringEx(NULL, NULL, bytes, pgvPtr->numBytes, TCL_ENCODING_PROFILE_TCL8, &ds, NULL); pgvPtr->numBytes = Tcl_DStringLength(&ds); pgvPtr->value = (char *)Tcl_Alloc(pgvPtr->numBytes + 1); @@ -4153,7 +4152,7 @@ TclSetProcessGlobalValue( if (pgvPtr->encoding) { Tcl_FreeEncoding(pgvPtr->encoding); } - pgvPtr->encoding = encoding; + pgvPtr->encoding = NULL; /* * Fill the local thread copy directly with the Tcl_Obj value to avoid @@ -4277,6 +4276,8 @@ TclGetProcessGlobalValue( * This function stores the absolute pathname of the executable file * (normally as computed by TclpFindExecutable). * + * Starting with Tcl 9.0, encoding parameter is not used any more. + * * Results: * None. * @@ -4289,9 +4290,9 @@ TclGetProcessGlobalValue( void TclSetObjNameOfExecutable( Tcl_Obj *name, - Tcl_Encoding encoding) + TCL_UNUSED(Tcl_Encoding)) { - TclSetProcessGlobalValue(&executableName, name, encoding); + TclSetProcessGlobalValue(&executableName, name); } /* -- cgit v0.12 From b4acb0d3391025f104ba4829623b4fb7c0f33f07 Mon Sep 17 00:00:00 2001 From: "jan.nijtmans" Date: Sat, 25 May 2024 09:09:52 +0000 Subject: Unneeded Tcl_DStringFree() (twice) --- generic/tclFileName.c | 1 - generic/tclPkg.c | 1 - 2 files changed, 2 deletions(-) diff --git a/generic/tclFileName.c b/generic/tclFileName.c index 5679a6c..54c583a 100644 --- a/generic/tclFileName.c +++ b/generic/tclFileName.c @@ -1777,7 +1777,6 @@ TclGlob( if (c != '\0') { tail++; } - Tcl_DStringFree(&buffer); } else { tail = pattern; } diff --git a/generic/tclPkg.c b/generic/tclPkg.c index 6a42a38..c82cd4d 100644 --- a/generic/tclPkg.c +++ b/generic/tclPkg.c @@ -538,7 +538,6 @@ PkgRequireCoreStep1( Tcl_NRAddCallback(interp, PkgRequireCoreStep2, reqPtr, INT2PTR(reqc), (void *) reqv, NULL); Tcl_NREvalObj(interp, Tcl_DStringToObj(&command), TCL_EVAL_GLOBAL); - Tcl_DStringFree(&command); return TCL_OK; } -- cgit v0.12 From 1a46ae83e5dcdceccd87a20aa607b9919340efb4 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 25 May 2024 13:53:52 +0000 Subject: Test to demonstrate [9ee9f4d7be]. Not fixed. --- tests/zlib.test | 34 ++++++++++++++++++++++++++++++++++ 1 file changed, 34 insertions(+) diff --git a/tests/zlib.test b/tests/zlib.test index 5312d2b..61bddd9 100644 --- a/tests/zlib.test +++ b/tests/zlib.test @@ -1117,6 +1117,40 @@ if {$zlibbinf ne ""} { unset zlibbinf rename _zlibbinf {} +test zlib-14.1 {Bug 9ee9f4d7be: compression header added to source channel} -setup { + set data hello + set src [file tempfile] + puts -nonewline $src $data + flush $src + chan configure $src -translation binary + set dst [file tempfile] + chan configure $dst -translation binary + set result {} +} -constraints knownBug -body { + for {set i 0} {$i < 3} {incr i} { + # Determine size of src channel + seek $src 0 end + set size [chan tell $src] + seek $src 0 start + # Determine size of content in src channel + set data [read $src] + set size2 [string length $data] + seek $src 0 start + # Copy src over to dst, keep dst empty + zlib push deflate $src -level 6 + chan truncate $dst 0 + chan copy $src $dst + set size3 [chan tell $dst] + chan pop $src + # Show sizes + lappend result $size $size2 ->$size3 + } + return $result +} -cleanup { + chan close $src + chan close $dst +} -result {5 5 ->5 5 5 ->5 5 5 ->5} + ::tcltest::cleanupTests return -- cgit v0.12 From a5d90257c2e0558387e24753ee7bfb86cbf4f353 Mon Sep 17 00:00:00 2001 From: dkf Date: Sat, 25 May 2024 15:18:54 +0000 Subject: Check limits immediately when we do [interp eval]. [e3f4a8b78d] --- generic/tclInterp.c | 13 +++++++++++++ tests/interp.test | 18 ++++++++++++++++-- 2 files changed, 29 insertions(+), 2 deletions(-) diff --git a/generic/tclInterp.c b/generic/tclInterp.c index b0f6207..ddca212 100644 --- a/generic/tclInterp.c +++ b/generic/tclInterp.c @@ -2795,6 +2795,18 @@ ChildEval( Tcl_Preserve(childInterp); Tcl_AllowExceptions(childInterp); + /* + * If we're transferring to another interpreter, check it's limits first. + * It's much more reliable to do that now rather than waiting for the + * intermittent checks done during running; the slight performance hit for + * a cross-interp call is not a big problem. [Bug e3f4a8b78d] + */ + + if (interp != childInterp && Tcl_LimitCheck(childInterp) != TCL_OK) { + result = TCL_ERROR; + goto done; + } + if (objc == 1) { /* * TIP #280: Make actual argument location available to eval'd script. @@ -2813,6 +2825,7 @@ ChildEval( result = Tcl_EvalObjEx(childInterp, objPtr, 0); Tcl_DecrRefCount(objPtr); } + done: Tcl_TransferResult(childInterp, result, interp); Tcl_Release(childInterp); diff --git a/tests/interp.test b/tests/interp.test index d742484..31c27ac 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -3326,13 +3326,13 @@ test interp-34.9 {time limits trigger in blocking after} { test interp-34.10 {time limits trigger in vwaits: Bug 1221395} -body { set i [interp create] # Assume someone hasn't set the clock to early 1970! - $i limit time -seconds 1 -granularity 4 + $i limit time -seconds [expr {[clock seconds] + 1}] -granularity 4 interp alias $i log {} lappend result set result {} catch { $i eval { log 1 - after 100 + after 1000 log 2 } } msg @@ -3409,6 +3409,20 @@ test interp-34.13 {time limit granularity and vwait: Bug 2891362} -setup { } -cleanup { interp delete $i } -returnCodes error -result {limit exceeded} +test interp-34.14 {[Bug e3f4a8b78d]: interp limit and interp eval} -setup { + set i [interp create] + set result {} +} -body { + $i limit command -value [$i eval {info cmdcount}] + catch {$i eval [list expr 1+3]} msg + lappend result $msg + catch {$i eval [list expr 1+3]} msg + lappend result $msg + catch {interp eval $i [list expr 1+3]} msg + lappend result $msg +} -cleanup { + interp delete $i +} -result {{command count limit exceeded} {command count limit exceeded} {command count limit exceeded}} test interp-35.1 {interp limit syntax} -body { interp limit -- cgit v0.12