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

  1. # Similar to interp-36.7
  2. # Threaded Tcl
  3. # Should never print 'err'
  4. # Sporadically prints 'err' on obsd with rthreads
  5.  
  6. proc handler {args} {
  7. global done
  8. set done [lindex $args 0]
  9. }
  10. interp bgerror {} handler
  11.  
  12. proc test367 {} {
  13. global done
  14. set done -1
  15. after 0 error 0
  16. after 10 [list set done 1]
  17. vwait done
  18. foreach i [after info] { after cancel $i }
  19. return $done
  20. }
  21.  
  22. for {set i 0} {$i < 1200} {incr i} {
  23. if {[test367] != 0} { puts err }
  24. }