Posted to tcl by Stu at Thu Apr 05 23:23:23 GMT 2012view raw
- # Similar to interp-36.7
- # Threaded Tcl
- # Should never print 'err'
- # Sporadically prints 'err' on obsd with rthreads
- proc handler {args} {
- global done
- set done [lindex $args 0]
- }
- interp bgerror {} handler
- proc test367 {} {
- global done
- set done -1
- after 0 error 0
- after 10 [list set done 1]
- vwait done
- foreach i [after info] { after cancel $i }
- return $done
- }
- for {set i 0} {$i < 1200} {incr i} {
- if {[test367] != 0} { puts err }
- }