#! /bin/env tclsh
package require {ycl shelf shelf}
namespace import [yclprefix]::shelf::shelf
package require {ycl test}
proc suite_main {} {
package require {ycl list}
namespace import [yclprefix]::list::sl
package require {ycl coro call}
namespace import [yclprefix]::coro::call::autocall
namespace import [yclprefix]::coro::call::bye
namespace import [yclprefix]::coro::call::call
namespace import [yclprefix]::coro::call::reply
[yclprefix] test init
namespace import [yclprefix]::test::cleanup1
test autocall {} -setup {} -body {
variable res
coroutine c1_coro ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
reply 5
} [namespace current]]
autocall c1 c1_coro
coroutine c2 ::apply [list args {
variable res
yield
lappend res [c1]
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
return $res
} -cleanup [cleanup1] -result [sl {
5
}]
test autocall {
The target command is resolved relative to the namespace the source
command is created in.
} -setup {} -body {
variable res
namespace eval c1 [list coroutine coro ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
reply 5
} [namespace current]]]
autocall c1 c1::coro
coroutine c2 ::apply [list args {
variable res
yield
lappend res [c1]
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
return $res
} -cleanup [cleanup1] -result [sl {
5
}]
test basic {} -setup {} -body {
variable res
coroutine c1 ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
set args [reply 5]
} [namespace current]]
coroutine c2 ::apply [list args {
variable res
yield
set res [call c1]
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
return $res
} -cleanup [cleanup1] -result [sl {
5
}]
test break {} -setup {} -body {
variable res
coroutine c1 ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
set args [reply 5]
bye
} [namespace current]]
coroutine c2 ::apply [list args {
yield
variable res
set new {}
while 1 {
lappend new [call c1]
}
lappend res $new
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
lappend res [namespace which c1]
return $res
} -cleanup [cleanup1] -result [sl {
5 {}
}]
test multi {} -setup {} -body {
variable res
coroutine c1 ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
reply 5
after 100 [list [info coroutine]]
yield
reply 10
reply -code break
reply 20
reply -code break
} [namespace current]]
coroutine c2 ::apply [list args {
variable res
yield
while 1 {
lappend new [call c1]
}
while 1 {
lappend new [call c1]
}
set res $new
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
return $res
} -cleanup [cleanup1] -result [sl {
5 10 20
}]
test error {} -setup {} -body {
variable res
coroutine c1 ::apply [list args {
reply
after 100 [list [info coroutine]]
yield
catch {abadcommand} cres copts
reply -options $copts $cres
} [namespace current]]
coroutine c2 ::apply [list args {
variable res
yield
catch {call c1} cres opts
lappend res [dict get $opts -code] $cres
} [namespace current]]
after 0 [list [namespace which c2]]
vwait [namespace current]::res
return $res
} -cleanup [cleanup1] -result [sl {
1 {invalid command name "abadcommand"}
}]
cleanupTests
}