summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2009-02-05 14:21:42 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2009-02-05 14:21:42 (GMT)
commitcd89b9ea6457cd428033dbb8b2f7746dd35222ed (patch)
tree596004a17d20a96f3f29775c6400a59cd9c7c043 /tests
parent7933720835766c9a797749bd47fd1501ae6871d2 (diff)
downloadtcl-cd89b9ea6457cd428033dbb8b2f7746dd35222ed.zip
tcl-cd89b9ea6457cd428033dbb8b2f7746dd35222ed.tar.gz
tcl-cd89b9ea6457cd428033dbb8b2f7746dd35222ed.tar.bz2
Fix [Bug 2568434]
Diffstat (limited to 'tests')
-rw-r--r--tests/execute.test68
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