Posted to tcl by Stu at Thu Apr 05 23:23:23 GMT 2012view pretty

# 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 }
}