summaryrefslogtreecommitdiffstats
path: root/tests/coroutine.test
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2010-04-30 12:38:46 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2010-04-30 12:38:46 (GMT)
commitd2d4b3a013a2e128e8f977d132e913770c62db64 (patch)
treeefaacdc6f06b38464783989ab7e86c5c3f2fdf71 /tests/coroutine.test
parent3e01004a237b5bdd39420d316a5be37c2c8215b8 (diff)
downloadtcl-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/coroutine.test')
-rw-r--r--tests/coroutine.test37
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