summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
Diffstat
-rw-r--r--generic/tclEncoding.c8
-rw-r--r--generic/tclInt.h2
-rw-r--r--generic/tclInterp.c13
-rw-r--r--generic/tclPkg.c6
-rw-r--r--generic/tclUtil.c13
-rw-r--r--tests/interp.test18
-rw-r--r--tests/zlib.test34
-rw-r--r--unix/tclUnixFile.c8
-rw-r--r--win/tclWinFCmd.c2
9 files changed, 79 insertions, 25 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/tclInterp.c b/generic/tclInterp.c
index 5fbefbf..e38ec2b 100644
--- a/generic/tclInterp.c
+++ b/generic/tclInterp.c
@@ -2842,6 +2842,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.
@@ -2860,6 +2872,7 @@ ChildEval(
result = Tcl_EvalObjEx(childInterp, objPtr, 0);
Tcl_DecrRefCount(objPtr);
}
+ done:
Tcl_TransferResult(childInterp, result, interp);
Tcl_Release(childInterp);
diff --git a/generic/tclPkg.c b/generic/tclPkg.c
index 50884a1..ef9c30d 100644
--- a/generic/tclPkg.c
+++ b/generic/tclPkg.c
@@ -537,11 +537,7 @@ PkgRequireCoreStep1(
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, Tcl_DStringToObj(&command), TCL_EVAL_GLOBAL);
return TCL_OK;
}
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);
}
/*
diff --git a/tests/interp.test b/tests/interp.test
index 30570bb..2505052 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
diff --git a/tests/zlib.test b/tests/zlib.test
index 6becb91..d993758 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -1119,6 +1119,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
diff --git a/unix/tclUnixFile.c b/unix/tclUnixFile.c
index ef2d4b9..93f6aa8 100644
--- a/unix/tclUnixFile.c
+++ b/unix/tclUnixFile.c
@@ -154,9 +154,7 @@ TclpFindExecutable(
#endif
{
Tcl_ExternalToUtfDStringEx(NULL, NULL, name, TCL_INDEX_NONE, TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), NULL);
- Tcl_DStringFree(&utfName);
+ TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);
goto done;
}
@@ -191,9 +189,7 @@ TclpFindExecutable(
Tcl_ExternalToUtfDStringEx(NULL, NULL, Tcl_DStringValue(&buffer), TCL_INDEX_NONE,
TCL_ENCODING_PROFILE_TCL8, &utfName, NULL);
- TclSetObjNameOfExecutable(
- Tcl_NewStringObj(Tcl_DStringValue(&utfName), TCL_INDEX_NONE), NULL);
- Tcl_DStringFree(&utfName);
+ TclSetObjNameOfExecutable(Tcl_DStringToObj(&utfName), NULL);
done:
Tcl_DStringFree(&buffer);
diff --git a/win/tclWinFCmd.c b/win/tclWinFCmd.c
index 0af484d..5a83425 100644
--- a/win/tclWinFCmd.c
+++ b/win/tclWinFCmd.c
@@ -926,7 +926,7 @@ TclpObjCopyDirectory(
} else if (!strcmp(Tcl_DStringValue(&ds), TclGetString(normDestPtr))) {
*errorPtr = destPathPtr;
} else {
- *errorPtr = Tcl_NewStringObj(Tcl_DStringValue(&ds), TCL_INDEX_NONE);
+ *errorPtr = Tcl_DStringToObj(&ds);
}
Tcl_DStringFree(&ds);
Tcl_IncrRefCount(*errorPtr);
generated by cgit v0.12 at 2024-10-22 17:41:51 (GMT)