diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/execute.test | 68 |
1 files changed, 30 insertions, 38 deletions
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 |