#! /bin/env tclsh
proc suite_main {} {
package require {ycl list}
namespace import [yclprefix]::list::sl
package require {ycl test}
[yclprefix]::test::init
namespace import [yclprefix]::test::cleanup1
package require {ycl coro relay}
namespace import [yclprefix]::coro::relay
namespace import [yclprefix]::coro::relay::order
variable dict [yclprefix]::coro
test call {} -body {
coroutine c1 apply [list {} {
variable done
set res {}
set i 0
for {set i 0} {$i < 10} {incr i} {
set id [relay call [expr {10 - $i}] ::tcl::mathop::+ $i $i]
}
while {[llength $res] < 10} {
set result [relay receive]
lappend res $result
}
lappend res [expr {[relay last] eq $id}]
set done $res
} [namespace current]]
vwait [namespace current]::done
set [namespace current]::done
} -result [list 18 16 14 12 10 8 6 4 2 0 0]
test order {} -body {
coroutine p1 apply [list {} {
while 1 {
relay accept {sender value}
relay deliver 0 $sender [expr {$value + $value}]
}
} [namespace current]]
coroutine c1 apply [list {} {
variable done
set res {}
set i 0
for {set i 0} {$i < 10} {incr i} {
set id [order [expr {int(10 - $i)}] p1 $i]
}
while {[llength $res] < 10} {
set result [relay receive]
lappend res $result
}
set done $res
} [namespace current]]
vwait [namespace current]::done
set [namespace current]::done
} -result [list 18 16 14 12 10 8 6 4 2 0]
test order_error {} -body {
coroutine p1 apply [list {} {
while 1 {
relay accept {sender value}
set res [expr {$value + $value}]
if {$res < 10} {
relay deliver 0 $sender [expr {$value + $value}]
} else {
relay deliver 0 $sender {exceeded max} {-code 1}
}
}
} [namespace current]]
coroutine c1 apply [list {} {
variable done
set res {}
set i 0
set errors 0
for {set i 0} {$i < 10} {incr i} {
set id [order [expr {int(20 * $i)}] p1 $i]
}
while {[llength $res] < 10} {
if {[catch {set result [relay receive]} result options]} {
if {$errors > 2} {
lappend res {too many errors}
set done $res
rename p1 {}
return
}
incr errors
}
lappend res $result
}
set done $res
} [namespace current]]
vwait [namespace current]::done
set [namespace current]::done
} -result [list 0 2 4 6 8 {exceeded max} {exceeded max} {exceeded max} {too many errors}]
test orderx {} -body {
coroutine p1 apply [list {} {
while {[incr i] < 10} {
relay deliver 0 [relay accept] [expr {$i + $i}]
}
} [namespace current]]
coroutine c1 apply [list {} {
variable done
set res {}
while {[namespace which [namespace current]::p1] ne {}} {
set id [order 0 p1]
set result [relay receive]
lappend res $result
}
set done $res
} [namespace current]]
vwait [namespace current]::done
set [namespace current]::done
} -result [list 2 4 6 8 10 12 14 16 18]
test switch {} -setup {} -body {
after 0 [list after idle [list coroutine p1 apply [list {} {
set b 13
while 1 {
relay deliver 0 {*}[relay switch routes {
custom1 {
set b
}}]
}
} [namespace current]]]]
after 0 [list after idle [list coroutine p2 apply [list {} {
order 0 p1 eval set a 5
set result [relay receive]
lappend results $result
order 0 p1 eval set a
set result [relay receive]
lappend results $result
order 0 p1 set a
catch {set result [relay receive]} cres
lappend results $cres
order 0 p1 custom1
set result [relay receive]
lappend results $result
lappend results [expr {[namespace which p1] eq {}}]
set [namespace current]::res $results
} [namespace current]]]]
vwait [namespace current]::res
set [namespace current]::res
} -cleanup [cleanup1] -result [sl {
5
5
{{unknown accept command} set}
13
0
}]
cleanupTests
}