diff options
author | Miguel Sofer <miguel.sofer@gmail.com> | 2008-09-01 12:28:04 (GMT) |
---|---|---|
committer | Miguel Sofer <miguel.sofer@gmail.com> | 2008-09-01 12:28:04 (GMT) |
commit | ba6dbcbada614e41a404b68b0b7edcca6f149f07 (patch) | |
tree | fa1c9d1fe32b5d73c3c14dfd86969f74574830e9 /tests | |
parent | 95660b09be94d6eb4b0482d33c78d8880e0c14cb (diff) | |
download | tcl-ba6dbcbada614e41a404b68b0b7edcca6f149f07.zip tcl-ba6dbcbada614e41a404b68b0b7edcca6f149f07.tar.gz tcl-ba6dbcbada614e41a404b68b0b7edcca6f149f07.tar.bz2 |
* generic/tclCmdAH.c: nre-enabling [eval]; eval scripts are now
* generic/tclOOBasic.c: bytecompiled. Adapted recursion limit tests
* tests/interp.test: that were relying on eval not being
* tests/nre.test: compiled. Part of the [Bug 2017632] project.
* tests/unsupported.test:
Diffstat (limited to 'tests')
-rw-r--r-- | tests/interp.test | 196 | ||||
-rw-r--r-- | tests/nre.test | 22 | ||||
-rw-r--r-- | tests/unsupported.test | 8 |
3 files changed, 204 insertions, 22 deletions
diff --git a/tests/interp.test b/tests/interp.test index 33dfda9..01e3ca8 100644 --- a/tests/interp.test +++ b/tests/interp.test @@ -10,7 +10,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: interp.test,v 1.60 2008/07/19 22:50:38 nijtmans Exp $ +# RCS: @(#) $Id: interp.test,v 1.61 2008/09/01 12:28:09 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -2623,7 +2623,12 @@ test interp-29.3.6 {recursion limit error reporting} { list $r1 $r2 } {0 ok} -test interp-29.3.7 {recursion limit error reporting} { +# +# Note that TEBC does not verify the interp's nesting level itself; the nesting +# level will only be verified when it invokes a non-bcc'd command. +# + +test interp-29.3.7a {recursion limit error reporting} { interp create slave after 0 {interp recursionlimit slave 5} set r1 [slave eval { @@ -2632,8 +2637,53 @@ test interp-29.3.7 {recursion limit error reporting} { eval { # 3 eval { # 4 eval { # 5 - update - set x ok + update + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.7b {recursion limit error reporting} { + interp create slave + after 0 {interp recursionlimit slave 5} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + update + eval { # 5 + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.7c {recursion limit error reporting} { + interp create slave + after 0 {interp recursionlimit slave 5} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + eval { # 5 + update + set set set + $set x ok } } } @@ -2645,7 +2695,7 @@ test interp-29.3.7 {recursion limit error reporting} { list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} -test interp-29.3.8 {recursion limit error reporting} { +test interp-29.3.8a {recursion limit error reporting} { interp create slave after 0 {interp recursionlimit slave 4} set r1 [slave eval { @@ -2654,8 +2704,30 @@ test interp-29.3.8 {recursion limit error reporting} { eval { # 3 eval { # 4 eval { # 5 - update - set x ok + update + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.8b {recursion limit error reporting} { + interp create slave + after 0 {interp recursionlimit slave 4} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + update + eval { # 5 + set x ok } } } @@ -2667,7 +2739,7 @@ test interp-29.3.8 {recursion limit error reporting} { list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} -test interp-29.3.9 {recursion limit error reporting} { +test interp-29.3.9a {recursion limit error reporting} { interp create slave after 0 {interp recursionlimit slave 6} set r1 [slave eval { @@ -2676,8 +2748,30 @@ test interp-29.3.9 {recursion limit error reporting} { eval { # 3 eval { # 4 eval { # 5 - update - set x ok + update + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.9b {recursion limit error reporting} { + interp create slave + after 0 {interp recursionlimit slave 6} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + eval { # 5 + set set set + $set x ok } } } @@ -2689,7 +2783,7 @@ test interp-29.3.9 {recursion limit error reporting} { list $r1 $r2 } {0 ok} -test interp-29.3.10 {recursion limit error reporting} { +test interp-29.3.10a {recursion limit error reporting} { interp create slave after 0 {slave recursionlimit 4} set r1 [slave eval { @@ -2709,9 +2803,31 @@ test interp-29.3.10 {recursion limit error reporting} { set r2 [slave eval { set msg }] interp delete slave list $r1 $r2 +} {0 ok} + +test interp-29.3.10b {recursion limit error reporting} { + interp create slave + after 0 {slave recursionlimit 4} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + update + eval { # 5 + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} -test interp-29.3.11 {recursion limit error reporting} { +test interp-29.3.11a {recursion limit error reporting} { interp create slave after 0 {slave recursionlimit 5} set r1 [slave eval { @@ -2720,8 +2836,31 @@ test interp-29.3.11 {recursion limit error reporting} { eval { # 3 eval { # 4 eval { # 5 - update - set x ok + update + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.11b {recursion limit error reporting} { + interp create slave + after 0 {slave recursionlimit 5} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + eval { # 5 + update + set set set + $set x ok } } } @@ -2733,7 +2872,7 @@ test interp-29.3.11 {recursion limit error reporting} { list $r1 $r2 } {1 {too many nested evaluations (infinite loop?)}} -test interp-29.3.12 {recursion limit error reporting} { +test interp-29.3.12a {recursion limit error reporting} { interp create slave after 0 {slave recursionlimit 6} set r1 [slave eval { @@ -2742,8 +2881,31 @@ test interp-29.3.12 {recursion limit error reporting} { eval { # 3 eval { # 4 eval { # 5 - update - set x ok + update + set x ok + } + } + } + } + } msg + }] + set r2 [slave eval { set msg }] + interp delete slave + list $r1 $r2 +} {0 ok} + +test interp-29.3.12b {recursion limit error reporting} { + interp create slave + after 0 {slave recursionlimit 6} + set r1 [slave eval { + catch { # nesting level 1 + eval { # 2 + eval { # 3 + eval { # 4 + eval { # 5 + update + set set set + $set x ok } } } diff --git a/tests/nre.test b/tests/nre.test index cc15b13..c415150 100644 --- a/tests/nre.test +++ b/tests/nre.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: nre.test,v 1.4 2008/08/22 18:27:27 dgp Exp $ +# RCS: @(#) $Id: nre.test,v 1.5 2008/09/01 12:28:10 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -236,6 +236,26 @@ test nre-7.5 {[foreach] is not recursive} -constraints {knownBug} -setup { unset abs } -result {{0 2 2 0} 0} +test nre-7.6 {[eval] is not recursive} -setup { + proc a i [makebody {eval [list a $i]}] +} -body { + setabs + a 0 +} -cleanup { + rename a {} + unset abs +} -result {{0 2 2 1} 0} + +test nre-7.7 {[eval] is not recursive} -setup { + proc a i [makebody {eval "a $i"}] +} -body { + setabs + a 0 +} -cleanup { + rename a {} + unset abs +} -result {{0 2 2 1} 0} + test nre-8.1 {nre and {*}} -body { # force an expansion that grows the evaluation stack, check that nre # adapts the bottomPtr. This crashes on failure. diff --git a/tests/unsupported.test b/tests/unsupported.test index 0267c58..37a9313 100644 --- a/tests/unsupported.test +++ b/tests/unsupported.test @@ -9,7 +9,7 @@ # See the file "license.terms" for information on usage and redistribution # of this file, and for a DISCLAIMER OF ALL WARRANTIES. # -# RCS: @(#) $Id: unsupported.test,v 1.7 2008/08/26 22:37:05 msofer Exp $ +# RCS: @(#) $Id: unsupported.test,v 1.8 2008/09/01 12:28:10 msofer Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -618,7 +618,7 @@ test unsupported-C.1.9 {yield in nested eval} -constraints {coroutine} \ } -cleanup { rename moo {} unset body res -} -returnCodes error -result {cannot yield: C stack busy} +} -result {0 10 20} test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \ -setup { @@ -629,7 +629,7 @@ test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \ yield while {$i < $imax} { - eval yield + eval yield [expr {$i*$stop}] incr i } } @@ -642,7 +642,7 @@ test unsupported-C.1.10 {yield in nested eval} -constraints {coroutine} \ set res } -cleanup { unset body res -} -returnCodes error -result {cannot yield: C stack busy} +} -result {0 10 20} test unsupported-C.1.11 {yield outside coroutine} -constraints {coroutine} \ -setup { |