#! /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::body
	namespace import [yclprefix]::coro::call::bye
	namespace import [yclprefix]::coro::call::call
	namespace import [yclprefix]::coro::call::callroutine
	namespace import [yclprefix]::coro::call::forward
	namespace import [yclprefix]::coro::call::hi
	namespace import [yclprefix]::coro::call::new
	namespace import [yclprefix]::coro::call::receive
	namespace import [yclprefix]::coro::call::relay
	namespace import [yclprefix]::coro::call::replier
	namespace import [yclprefix]::coro::call::reply
	namespace import [yclprefix]::coro::call::replyafter
	namespace import [yclprefix]::coro::call::timeout

	[yclprefix] test init
	namespace import [yclprefix]::test::cleanup1

	test after {} -setup {} -body {
		variable res

		coroutine c3 ::apply [list {} {
			hi
			# Never replies
		} [namespace current]]

		coroutine c1 ::apply [list {} {
			variable res
			hi
			timeout 100 {the answer}
			lappend res [call c3]
			lappend res [namespace tail [replier]]
		} [namespace current]]

		coroutine c2 ::apply [list {} {
			yield
			call c1
		} [namespace current]]
		after 0 [list [namespace which c2]]
		vwait [namespace current]::res
		return $res
	} -cleanup [cleanup1] -result [sl {
		{the answer} c1
	}]

	test after_error {} -setup {} -body {
		variable res

		coroutine c3 ::apply [list {} {
			hi
			# Never replies
		} [namespace current]]

		coroutine c1 ::apply [list args {
			variable res
			hi
			timeout 100 -code error {bleep bloop}
			catch {call c3} cres copts
			lappend res $cres [dict get $copts -code] [
				namespace tail [replier]]
		} [namespace current]]

		coroutine c2 ::apply [list args {
			yield
			call c1
		} [namespace current]]
		after 0 [list [namespace which c2]]
		vwait [namespace current]::res
		return $res
	} -cleanup [cleanup1] -result [sl {
		{bleep bloop} 1 c1
	}]

	test autocall {} -setup {} -body {
		variable res
		coroutine c1\0 ::apply [list args {
			hi
			after 100 [list [info coroutine]]
			yield
			reply 5
		} [namespace current]]
		autocall c1

		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_resolve {
		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 {
			hi
			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 {
			hi
			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 {
			hi 
			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 {
			hi
			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 {
			hi
			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"}
	}]

	test body {} -setup {} -body {
		proc r1 arg1 [body {
			hi
			for {set i 3} {$i < 8} {incr i} {
				reply $i
			}
		}]
		callroutine c1 r1 something

		while 1 {
			lappend res [c1]
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		3 4 5 6 7
	}]

	test body_scripterror {} -setup {} -body {
		proc r1 arg1 [body {
			hi
			not [a good script
		}]
		callroutine c1 r1 something

		catch c1 cres copts
		return $cres
	} -cleanup [cleanup1] -result [sl {
		missing close-bracket
	}]

	test forward {} -setup {} -body {
		variable result
		proc r1 {} [body {
			set arg1 [hi]
			for {set i 3} {$i < 8} {incr i} {
				set arg1 [reply [list $i $arg1]]
			}
		}]
		coroutine c1 r1

		coroutine recipient ::apply [list destination {
			set target [list ::return -level 0]
			set item {}
			set copts {}
			while 1 {
				catch {call {*}$target -options $copts $item} item copts
				set target [list $destination]
			}
		} [namespace current]] [info coroutine]

		while 1 {
			lappend res [forward [namespace which recipient] [namespace which c1] [expr {[incr i] + 11}]]
		}
		return $res
	} -cleanup [cleanup1] -result [sl {
		{3 12} {4 13} {5 14} {6 15} {7 16}
	}]

	test new {} -setup {} -body {
		variable res

		new c1 ::apply [list args {
			hi
			after 100 [list [info coroutine]]
			yield
			set args [reply 5]
		} [namespace current]]

		coroutine c2 ::apply [list args {
			variable res
			yield
			set res [c1]
		} [namespace current]]
		after 0 [list [namespace which c2]]
		vwait [namespace current]::res
		return $res
	} -cleanup [cleanup1] -result [sl {
		5
	}]

	cleanupTests
}
