Basic test of yielding inside a subst

1 files changed, 10 insertions, 38 deletions

diff --git a/tests/coroutine.test b/tests/coroutine.test
index 29c68e9..9b26e09 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.3 2009/08/02 14:26:07 msofer Exp $
+# RCS: @(#) $Id: coroutine.test,v 1.4 2009/09/07 09:43:32 dkf Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest
@@ -63,14 +63,12 @@ set lambda [list {{start 0} {stop 10}} {
     set i    $start
     set imax $stop
     yield
-    
     while {$i < $imax} {
 	yield [expr {$i*$stop}]
 	incr i
     }
 }]
-	
-
+
 test coroutine-1.1 {coroutine basic} -setup {
     coroutine foo ::apply $lambda
     set res {}
@@ -83,7 +81,6 @@ test coroutine-1.1 {coroutine basic} -setup {
     rename foo {}
     unset res
 } -result {0 10 20}
-
 test coroutine-1.2 {coroutine basic} -setup {
     coroutine foo ::apply $lambda 2 8
     set res {}
@@ -96,14 +93,12 @@ test coroutine-1.2 {coroutine basic} -setup {
     rename foo {}
     unset res
 } -result {16 24 32}
-
 test coroutine-1.3 {yield returns new arg} -setup {
     set body {
 	# init
 	set i    $start
 	set imax $stop
 	yield
-	
 	while {$i < $imax} {
 	    set stop [yield [expr {$i*$stop}]]
 	    incr i
@@ -120,7 +115,6 @@ test coroutine-1.3 {yield returns new arg} -setup {
     rename foo {}
     unset res
 } -result {20 6 12}
-
 test coroutine-1.4 {yield in nested proc} -setup {
     proc moo {} {
 	upvar 1 i i stop stop
@@ -131,7 +125,6 @@ test coroutine-1.4 {yield in nested proc} -setup {
 	set i    $start
 	set imax $stop
 	yield
-
 	while {$i < $imax} {
 	    moo
 	    incr i
@@ -149,28 +142,24 @@ test coroutine-1.4 {yield in nested proc} -setup {
     rename moo {}
     unset body res
 } -result {0 10 20}
-
 test coroutine-1.5 {just yield} -body {
     coroutine foo yield
     list [foo] [catch foo msg] $msg
 } -cleanup {
     unset msg
 } -result {{} 1 {invalid command name "foo"}}
-
 test coroutine-1.6 {just yield} -body {
     coroutine foo [list yield]
     list [foo] [catch foo msg] $msg
 } -cleanup {
     unset msg
 } -result {{} 1 {invalid command name "foo"}}
-
 test coroutine-1.7 {yield in nested uplevel} -setup {
     set body {
 	# init
 	set i    $start
 	set imax $stop
 	yield
-
 	while {$i < $imax} {
 	    uplevel 0 [list yield [expr {$i*$stop}]]
 	    incr i
@@ -187,14 +176,12 @@ test coroutine-1.7 {yield in nested uplevel} -setup {
     rename foo {}
     unset body res
 } -result {0 10 20}
-
 test coroutine-1.8 {yield in nested uplevel} -setup {
     set body {
 	# init
 	set i    $start
 	set imax $stop
 	yield
-	
 	while {$i < $imax} {
 	    uplevel 0 yield [expr {$i*$stop}]
 	    incr i
@@ -211,7 +198,6 @@ test coroutine-1.8 {yield in nested uplevel} -setup {
     rename foo {}
     unset body res
 } -result {0 10 20}
-
 test coroutine-1.9 {yield in nested eval} -setup {
     proc moo {} {
 	upvar 1 i i stop stop
@@ -222,7 +208,6 @@ test coroutine-1.9 {yield in nested eval} -setup {
 	set i    $start
 	set imax $stop
 	yield
-
 	while {$i < $imax} {
 	    eval moo
 	    incr i
@@ -239,14 +224,12 @@ test coroutine-1.9 {yield in nested eval} -setup {
     rename moo {}
     unset body res
 } -result {0 10 20}
-
 test coroutine-1.10 {yield in nested eval} -setup {
     set body {
 	# init
 	set i    $start
 	set imax $stop
 	yield
-	
 	while {$i < $imax} {
 	    eval yield [expr {$i*$stop}]
 	    incr i
@@ -262,7 +245,6 @@ test coroutine-1.10 {yield in nested eval} -setup {
 } -cleanup {
     unset body res
 } -result {0 10 20}
-
 test coroutine-1.11 {yield outside coroutine} -setup {
     proc moo {} {
 	upvar 1 i i stop stop
@@ -275,14 +257,12 @@ test coroutine-1.11 {yield outside coroutine} -setup {
     rename moo {}
     unset i stop
 } -returnCodes error -result {yield can only be called in a coroutine}
-
 test coroutine-1.12 {proc as coroutine} -setup {
     set body {
 	# init
 	set i    $start
 	set imax $stop
 	yield
-	
 	while {$i < $imax} {
 	    uplevel 0 [list yield [expr {$i*$stop}]]
 	    incr i
@@ -297,32 +277,30 @@ test coroutine-1.12 {proc as coroutine} -setup {
     rename moo {}
     rename foo {}
 } -result {16 24}
+test coroutine-1.13 {subst as coroutine} {
+    list [coroutine foo subst {>>[yield a],[yield b]<<}] [foo x] [foo y]
+} {a b >>x,y<<}
 
 test coroutine-2.1 {self deletion on return} -body {
     coroutine foo set x 3
     foo
 } -returnCodes error -result {invalid command name "foo"}
-
 test coroutine-2.2 {self deletion on return} -body {
     coroutine foo ::apply [list {} {yield; yield 1; return 2}]
     list [foo] [foo] [catch foo msg] $msg
 } -result {1 2 1 {invalid command name "foo"}}
-
 test coroutine-2.3 {self deletion on error return} -body {
     coroutine foo ::apply [list {} {yield;yield 1; error ouch!}]
     list [foo] [catch foo msg] $msg [catch foo msg] $msg
 } -result {1 1 ouch! 1 {invalid command name "foo"}}
-
 test coroutine-2.4 {self deletion on other return} -body {
     coroutine foo ::apply [list {} {yield;yield 1; return -code 100 ouch!}]
     list [foo] [catch foo msg] $msg [catch foo msg] $msg
 } -result {1 100 ouch! 1 {invalid command name "foo"}}
-
 test coroutine-2.5 {deletion of suspended coroutine} -body {
     coroutine foo ::apply [list {} {yield; yield 1; return 2}]
     list [foo] [rename foo {}] [catch foo msg] $msg
 } -result {1 {} 1 {invalid command name "foo"}}
-
 test coroutine-2.6 {deletion of running coroutine} -body {
     coroutine foo ::apply [list {} {yield; rename foo {}; yield 1; return 2}]
     list [foo] [catch foo msg] $msg
@@ -341,7 +319,6 @@ test coroutine-3.1 {info level computation} -setup {
     rename a {}
     rename b {}
 } -result {1 1 1}
-
 test coroutine-3.2 {info frame computation} -setup {
     proc a {} {while 1 {yield [info frame]}}
     proc b {} foo
@@ -354,7 +331,6 @@ test coroutine-3.2 {info frame computation} -setup {
     rename a {}
     rename b {}
 } -result 1
-
 test coroutine-3.3 {info coroutine} -setup {
     proc a {} {info coroutine}
     proc b {} a
@@ -364,7 +340,6 @@ test coroutine-3.3 {info coroutine} -setup {
     rename a {}
     rename b {}
 } -result {}
-
 test coroutine-3.4 {info coroutine} -setup {
     proc a {} {info coroutine}
     proc b {} a
@@ -374,7 +349,6 @@ test coroutine-3.4 {info coroutine} -setup {
     rename a {}
     rename b {}
 } -result ::foo
-
 test coroutine-3.5 {info coroutine} -setup {
     proc a {} {info coroutine}
     proc b {} {rename [info coroutine] {}; a}
@@ -385,7 +359,6 @@ test coroutine-3.5 {info coroutine} -setup {
     rename b {}
 } -result {}
 
-
 test coroutine-4.1 {bug #2093188} -setup {
     proc foo {} {
 	set v 1
@@ -404,7 +377,6 @@ test coroutine-4.1 {bug #2093188} -setup {
     rename bar {}
     unset ::res
 } -result {{} 3 {{v {} write} {v {} write} {v {} unset}}}
-
 test coroutine-4.2 {bug #2093188} -setup {
     proc foo {} {
 	set v 1
@@ -424,7 +396,6 @@ test coroutine-4.2 {bug #2093188} -setup {
     rename bar {}
     unset ::res
 } -result {{} 3 {{v {} read} {v {} unset}}}
-
 test coroutine-4.3 {bug #2093947} -setup {
     proc foo {} {
 	set v 1
@@ -472,7 +443,6 @@ test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels}
     set base [getNumLevel]
     lappend res [relativeLevel $base]
     eval {coroutine a foo}
-
     # back to base level
     lappend res [relativeLevel $base]
     a
@@ -491,7 +461,6 @@ test coroutine-5.1 {right numLevels on coro return} -constraints {testnrelevels}
     rename relativeLevel {}
     unset res
 } -result {0 0 0 0 0 0}
-
 test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
 -setup {
     proc nestedYield {{val {}}} {
@@ -529,7 +498,7 @@ test coroutine-5.2 {right numLevels within coro} -constraints {testnrelevels} \
     rename relativeLevel {}
     unset res
 } -result {0 0 0 0}
-
+
 unset lambda
 
 if {[testConstraint testnrelevels]} {
@@ -540,5 +509,8 @@ if {[testConstraint testnrelevels]} {
 # cleanup
 ::tcltest::cleanupTests
 
-
 return
+
+# Local-Variables:
+# mode: tcl
+# End: