diff options
| -rw-r--r-- | generic/tclInterp.c | 13 | ||||
| -rw-r--r-- | tests/interp.test | 18 | ||||
| -rw-r--r-- | tests/zlib.test | 34 |
3 files changed, 63 insertions, 2 deletions
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/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 |