summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2012-04-02 13:13:11 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2012-04-02 13:13:11 (GMT)
commit4c5e1cc6db788396e73b9edeeaebb92096dc644b (patch)
treef3c0b8c4123f5ce11546ed84f8f1e0090206c015 /tests
parent968face14f7b3c39dab97d0457c869427402bc63 (diff)
downloadtcl-4c5e1cc6db788396e73b9edeeaebb92096dc644b.zip
tcl-4c5e1cc6db788396e73b9edeeaebb92096dc644b.tar.gz
tcl-4c5e1cc6db788396e73b9edeeaebb92096dc644b.tar.bz2
Implementation of TIP #396
Diffstat (limited to 'tests')
-rw-r--r--tests/coroutine.test49
1 files changed, 34 insertions, 15 deletions
diff --git a/tests/coroutine.test b/tests/coroutine.test
index 7d5169b..7f40a7b 100644
--- a/tests/coroutine.test
+++ b/tests/coroutine.test
@@ -557,12 +557,25 @@ test coroutine-6.3 {coroutine nargs} -body {
} -cleanup {
rename a {}
} -returnCodes error -result {wrong # args: should be "a ?arg?"}
-test coroutine-6.4 {unsupported: multi-argument yield} -body {
+
+test coroutine-7.1 {yieldto} -body {
+ coroutine c apply {{} {
+ yield
+ yieldto return -level 0 -code 1 quux
+ return quuy
+ }}
+ set res [list [catch c msg] $msg]
+ lappend res [catch c msg] $msg
+ lappend res [catch c msg] $msg
+} -cleanup {
+ unset res
+} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
+test coroutine-7.2 {multi-argument yielding with yieldto} -body {
proc corobody {} {
set a 1
while 1 {
set a [yield $a]
- set a [::tcl::unsupported::yieldm $a]
+ set a [yieldto return -level 0 $a]
lappend a [llength $a]
}
}
@@ -573,20 +586,26 @@ test coroutine-6.4 {unsupported: multi-argument yield} -body {
} -cleanup {
rename corobody {}
} -result {x {y z 2} \{p {\{q r 2} {} 0 {} ok {}}
-
-test coroutine-7.1 {yieldTo} -body {
- coroutine c apply {{} {
- yield
- tcl::unsupported::yieldTo return -level 0 -code 1 quux
- return quuy
- }}
- set res [list [catch c msg] $msg]
- lappend res [catch c msg] $msg
- lappend res [catch c msg] $msg
+test coroutine-7.3 {yielding between coroutines} -body {
+ proc juggler {target {value ""}} {
+ if {$value eq ""} {
+ set value [yield [info coroutine]]
+ }
+ while {[llength $value]} {
+ lappend ::result $value [info coroutine]
+ set value [lrange $value 0 end-1]
+ lassign [yieldto $target $value] value
+ }
+ # Clear nested collection of coroutines
+ catch $target
+ }
+ set result ""
+ coroutine j1 juggler [coroutine j2 juggler [coroutine j3 juggler j1]]\
+ {a b c d e}
+ list $result [info command j1] [info command j2] [info command j3]
} -cleanup {
- unset res
-} -result [list 1 quux 0 quuy 1 {invalid command name "c"}]
-
+ catch {rename juggler ""}
+} -result {{{a b c d e} ::j1 {a b c d} ::j2 {a b c} ::j3 {a b} ::j1 a ::j2} {} {} {}}
# cleanup
unset lambda