diff options
author | dkf <donal.k.fellows@manchester.ac.uk> | 2010-04-30 12:38:46 (GMT) |
---|---|---|
committer | dkf <donal.k.fellows@manchester.ac.uk> | 2010-04-30 12:38:46 (GMT) |
commit | d2d4b3a013a2e128e8f977d132e913770c62db64 (patch) | |
tree | efaacdc6f06b38464783989ab7e86c5c3f2fdf71 /tests | |
parent | 3e01004a237b5bdd39420d316a5be37c2c8215b8 (diff) | |
download | tcl-d2d4b3a013a2e128e8f977d132e913770c62db64.zip tcl-d2d4b3a013a2e128e8f977d132e913770c62db64.tar.gz tcl-d2d4b3a013a2e128e8f977d132e913770c62db64.tar.bz2 |
Fix the problems I introduced inadvertently:
* generic/tclBasic.c (NRInterpCoroutine): Corrected handling of
* tests/coroutine.test (coroutine-6.4): arguments to deal with
trickier cases.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/coroutine.test | 37 |
1 files changed, 23 insertions, 14 deletions
diff --git a/tests/coroutine.test b/tests/coroutine.test index 448ce4d..d563aa4 100644 --- a/tests/coroutine.test +++ b/tests/coroutine.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: coroutine.test,v 1.12 2010/04/30 12:30:07 msofer Exp $ +# RCS: @(#) $Id: coroutine.test,v 1.13 2010/04/30 12:38:46 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest @@ -515,35 +515,44 @@ test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \ rename relativeLevel {} unset res } -result {0 0 0 0} - -test coroutine-6.1 {coroutine nargs} \ --body { +test coroutine-6.1 {coroutine nargs} -body { coroutine a ::apply $lambda a } -cleanup { rename a {} } -result 0 - -test coroutine-6.2 {coroutine nargs} \ --body { +test coroutine-6.2 {coroutine nargs} -body { coroutine a ::apply $lambda a a } -cleanup { rename a {} } -result 0 - -test coroutine-6.3 {coroutine nargs} \ --body { +test coroutine-6.3 {coroutine nargs} -body { coroutine a ::apply $lambda a a a } -cleanup { rename a {} -} -returnCodes error - -unset lambda - +} -returnCodes error -result {wrong # args: should be "a ?arg?"} +test coroutine-6.4 {unsupported: multi-argument yield} -body { + proc corobody {} { + set a 1 + while 1 { + set a [yield $a] + set a [::tcl::unsupported::yieldm $a] + lappend a [llength $a] + } + } + coroutine a corobody + coroutine b corobody + list [a x] [a y z] [a \{p] [a \{q r] [a] [a] [rename a {}] \ + [b ok] [rename b {}] +} -cleanup { + rename corobody {} +} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}} + # cleanup +unset lambda ::tcltest::cleanupTests return |