Posted to tcl by kostix at Mon Apr 07 23:06:39 GMT 2008view raw

  1. proc foo {id} {
  2. variable $id; upvar 0 $id state
  3.  
  4. after 1000 [list bar $id]
  5.  
  6. set token [namespace current]::${id}(result)
  7. }
  8.  
  9. proc bar {id} {
  10. variable $id; upvar 0 $id state
  11.  
  12. unset state
  13.  
  14. quux "some error"
  15. }
  16.  
  17. proc quux {reason} {
  18. return -code error $reason
  19. }
  20.  
  21. proc waiter {id} {
  22. set token [foo $id]
  23.  
  24. vwait $token
  25. }
  26.  
  27. waiter 0xdeadbeef
  28.  
  29. puts OK
  30.