diff options
| -rw-r--r-- | ChangeLog | 3 | ||||
| -rw-r--r-- | generic/tclExecute.c | 8 | ||||
| -rw-r--r-- | tests/execute.test | 68 |
3 files changed, 39 insertions, 40 deletions
@@ -1,5 +1,8 @@ 2009-02-05 Donal K. Fellows <dkf@users.sf.net> + * generic/tclExecute.c (TclExecuteByteCode): Make sure that + INST_CONCAT1 will not lose string reps wrongly. [Bug 2568434] + * generic/tclStringObj.c (Tcl_AppendObjToObj): Special-case the appending of one bytearray to another, which can be extremely rapid. Part of scheme to address [Bug 1665628] by making the basic string diff --git a/generic/tclExecute.c b/generic/tclExecute.c index d1c29eb..601fe6e 100644 --- a/generic/tclExecute.c +++ b/generic/tclExecute.c @@ -14,7 +14,7 @@ * See the file "license.terms" for information on usage and redistribution of * this file, and for a DISCLAIMER OF ALL WARRANTIES. * - * RCS: @(#) $Id: tclExecute.c,v 1.424 2009/01/09 11:21:45 dkf Exp $ + * RCS: @(#) $Id: tclExecute.c,v 1.425 2009/02/05 14:21:42 dkf Exp $ */ #include "tclInt.h" @@ -2448,7 +2448,7 @@ TclExecuteByteCode( opnd = TclGetUInt1AtPtr(pc+1); /* - * Detect only-bytearray-or-null case + * Detect only-bytearray-or-null case. */ for (currPtr=&OBJ_AT_DEPTH(opnd-1); currPtr<=&OBJ_AT_TOS; currPtr++) { @@ -2456,6 +2456,10 @@ TclExecuteByteCode( && ((*currPtr)->bytes != tclEmptyStringRep)) { onlyb = 0; break; + } else if (((*currPtr)->typePtr == &tclByteArrayType) && + ((*currPtr)->bytes != NULL)) { + onlyb = 0; + break; } } diff --git a/tests/execute.test b/tests/execute.test index d9f02e0..f6174d0 100644 --- a/tests/execute.test +++ b/tests/execute.test @@ -14,7 +14,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: execute.test,v 1.29 2008/08/05 15:52:24 msofer Exp $ +# RCS: @(#) $Id: execute.test,v 1.30 2009/02/05 14:21:43 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2 @@ -43,14 +43,12 @@ testConstraint testexprlongobj [llength [info commands testexprlongobj]] # INST_PUSH4 not tested # INST_POP not tested # INST_DUP not tested -# INST_CONCAT1 not tested # INST_INVOKE_STK4 not tested # INST_INVOKE_STK1 not tested # INST_EVAL_STK not tested # INST_EXPR_STK not tested # INST_LOAD_SCALAR1 - test execute-1.1 {TclExecuteByteCode, INST_LOAD_SCALAR1, small opnd} { proc foo {} { set x 1 @@ -68,7 +66,6 @@ test execute-1.2 {TclExecuteByteCode, INST_LOAD_SCALAR1, large opnd} { set y 1 return $y } - proc foo {} $body foo } 1 @@ -81,9 +78,7 @@ test execute-1.3 {TclExecuteByteCode, INST_LOAD_SCALAR1, error} { list [catch {foo} msg] $msg } {1 {can't read "x": no such variable}} - # INST_LOAD_SCALAR4 - test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} { set body {} for {set i 0} {$i < 256} {incr i} { @@ -93,7 +88,6 @@ test execute-2.1 {TclExecuteByteCode, INST_LOAD_SCALAR4, simple case} { set y 1 return $y } - proc foo {} $body foo } 1 @@ -107,12 +101,10 @@ test execute-2.2 {TclExecuteByteCode, INST_LOAD_SCALAR4, error} { unset y return $y } - proc foo {} $body list [catch {foo} msg] $msg } {1 {can't read "y": no such variable}} - # INST_LOAD_SCALAR_STK not tested # INST_LOAD_ARRAY4 not tested # INST_LOAD_ARRAY1 not tested @@ -900,43 +892,40 @@ test execute-8.1 {Stack protection} -setup { trace remove variable ::errorInfo {write unset} whatever rename whatever {} } -returnCodes error -match glob -result * - test execute-8.2 {Stack restoration} -body { # Test for [Bug #816641], correct restoration # of the stack top after the stack is grown - proc f {args} { f bee bop } - catch f msg - set msg - } -setup { + proc f {args} { f bee bop } + catch f msg + set msg +} -setup { # Avoid crashes when system stack size is limited (thread-enabled!) - set limit [interp recursionlimit {}] - interp recursionlimit {} 100 - } -cleanup { - interp recursionlimit {} $limit - } -result {too many nested evaluations (infinite loop?)} - + set limit [interp recursionlimit {}] + interp recursionlimit {} 100 +} -cleanup { + interp recursionlimit {} $limit +} -result {too many nested evaluations (infinite loop?)} test execute-8.3 {Stack restoration} -body { # Test for [Bug #1055676], correct restoration # of the stack top after the epoch is bumped and # the stack is grown in a call from a nested evaluation - set arglst [string repeat "a " 1000] - proc f {args} "f $arglst" - proc run {} { - # bump the interp's epoch - rename ::set ::dummy - rename ::dummy ::set - catch f msg - set msg - } - run - } -setup { + set arglst [string repeat "a " 1000] + proc f {args} "f $arglst" + proc run {} { + # bump the interp's epoch + rename ::set ::dummy + rename ::dummy ::set + catch f msg + set msg + } + run +} -setup { # Avoid crashes when system stack size is limited (thread-enabled!) - set limit [interp recursionlimit {}] - interp recursionlimit {} 100 - } -cleanup { - interp recursionlimit {} $limit - } -result {too many nested evaluations (infinite loop?)} - + set limit [interp recursionlimit {}] + interp recursionlimit {} 100 +} -cleanup { + interp recursionlimit {} $limit +} -result {too many nested evaluations (infinite loop?)} test execute-8.4 {Compile epoch bump effect on stack trace} -setup { proc foo {} { error bar @@ -957,7 +946,6 @@ test execute-8.4 {Compile epoch bump effect on stack trace} -setup { rename foo {} rename FOO {} } -result {} - test execute-8.5 {Bug 2038069} -setup { proc demo {} { catch [list error FOO] m o @@ -987,6 +975,10 @@ test execute-9.1 {Interp result resetting [Bug 1522803]} { set result } SUCCESS +test execute-10.1 {TclExecuteByteCode, INST_CONCAT1, bytearrays} { + apply {s {binary scan $s c x; list $x [scan $s$s %c%c]}} \u0130 +} {48 {304 304}} + # cleanup if {[info commands testobj] != {}} { testobj freeallvars |