Posted to tcl by colin at Wed Nov 17 00:49:24 GMT 2010view pretty
namespace eval tcl::unsupported namespace export yieldm namespace import tcl::unsupported::yieldm proc reader {} { while {1} { ::yieldm } } oo::class create ::Lamb { # reader - main coroutine supervising connection method reader {} { while {1} { ::yieldm } } constructor {args} { variable ns [info object namespace [self]] variable coro ${ns}::coro ::coroutine $coro [self] reader ;# will crash #::coroutine $coro ::reader ;# will not crash } } proc every {interval script} { global everyIds if {$interval eq "cancel"} { after cancel $everyIds($script) return } set everyIds($script) [after $interval [info level 0]] set rc [catch {uplevel #0 $script} result] if {$rc == [catch break]} { after cancel $everyIds($script) set rc 0 } elseif {$rc == [catch continue]} { # Ignore - just consume the return code set rc 0 } # TODO: Need better handling of errorInfo etc... return -code $rc $result } every 100 { set obj [Lamb new] puts stderr "New Lamb: $obj" } every 1000 { foreach o [info class instances ::Lamb] { catch {$o destroy} } } every 2000 { foreach o [info class instances ::Lamb] { if {[catch {info object namespace $o} ns]} { error "$o is undead" } else { if {![namespace exists $ns]} { puts stderr "$o namespace nonexistent" } if {![llength [info commands $o]]} { puts stderr "$o no command" } } } } set forever 0 ::vwait forever