#! /bin/env tclsh
package require {ycl test}
proc suite_main {} {
package require {ycl coro}
namespace import [yclprefix]::coro
namespace import [yclprefix]::coro::callers
namespace import [yclprefix]::coro::interp
namespace import [yclprefix]::coro::eval
namespace import [yclprefix]::coro::upcoro
namespace import [yclprefix]::coro::suspend
package require {ycl list}
namespace import [yclprefix]::list::sl
[yclprefix] test init
namespace import [yclprefix]::test::cleanup1
test callers {} -body {
variable res
coroutine c1 ::apply [list {} {
coroutine c2 ::apply [list {} {
coroutine c3 ::apply [list {} {
coroutine c4 ::apply [list {} {
variable res
lappend res {*}[lmap caller [callers] {
namespace tail $caller
}]
} [namespace current]]
} [namespace current]]
} [namespace current]]
} [namespace current]]
set res
} -cleanup [cleanup1] -result [sl {
c3 c2 c1 main
}]
test callers_loop {
sure "too many nexted evaluations" error should not occur
} -body {
variable res
coroutine c1 ::apply [list {} {
coroutine c2 ::apply [list {} {
coroutine c3 ::apply [list {} {
coroutine c4 ::apply [list {} {
variable res
for {set i 0} {$i < 65536} {incr i} {
incr res
callers
}
} [namespace current]]
} [namespace current]]
} [namespace current]]
} [namespace current]]
set res
} -cleanup [cleanup1] -result [sl {
65536
}]
test callers_nocoro {} -body {
variable res
lappend res [callers]
set res
} -cleanup [cleanup1] -result [sl {
{}
}]
test interp {} -body {
set coro [interp i1 init {
set var1 33
}]
lappend res [expr {[namespace tail $coro] eq {i1}}]
lappend res [i1 eval {
set var1
}]
lappend res [expr {{switch} in [i1 local {info locals}]}]
i1 return
lappend res [namespace which [namespace current]::i1]
return $res
} -cleanup [cleanup1] -result [sl {
1 33 1 {}
}]
test eval {} -body {
coroutine c1 ::apply [list {} {
coro eval {set a 5}
} [namespace current]]
return $a
} -cleanup [cleanup1] -result [sl {
5
}]
test eval_error {} -body {
coroutine c1 ::apply [list {} {
yield
coro eval {error yup}
} [namespace current]]
catch c1 cres copts
lappend res $cres [dict get $copts -level]
return $res
} -cleanup [cleanup1] -result [sl {
yup 0
}]
test return {} -body {
variable done
coroutine c1 ::apply [list {} {
yield [info coroutine]
coro return -level 0 -code break
} [namespace current]]
for {set i 3} {$i < 10} {incr i} {
c1
}
lappend res $i
return $res
} -cleanup [cleanup1] -result [sl {
3
}]
test suspend {} -body {
variable done
coroutine c1 ::apply [list {} {
variable done
suspend coroutine
after 10 [list [info coroutine]]
yield
set done hello
::tailcall $coroutine -level 0
} [namespace current]]
lappend res $done
return $res
} -cleanup [cleanup1] -result [sl {
hello
}]
cleanupTests
}