Posted to tcl by evilotto at Mon Nov 29 22:56:26 GMT 2010view raw

  1. proc server {s r p} {
  2. after 1000 "puts $s xyz; close $s"
  3. }
  4.  
  5. set socket 11111
  6. set host localhost
  7.  
  8. set ssock [socket -server server $socket]
  9.  
  10. # comment out this next line and this works normally!
  11. close [socket $host 11111]
  12.  
  13. # calibrate
  14. set ms 200
  15. set s [clock clicks]
  16. after $ms
  17. set e [clock clicks]
  18. set r [expr {($e-$s)/$ms}]
  19.  
  20. proc evwait {s} {
  21. _evwait ::_ev [expr [clock clicks]+$s*$::r]
  22. vwait ::_ev
  23. unset ::_ev
  24. }
  25.  
  26. proc _evwait {v e} {
  27. if {[clock clicks] < $e} {
  28. after idle [list _evwait $v $e]
  29. return
  30. } else {
  31. set $v 0
  32. }
  33. }
  34.  
  35. set count no
  36. proc report {} {
  37. puts "$::count loops"
  38. if {$::count == 0} {
  39. puts stderr "count died!"
  40. # close $::ssock
  41. exit
  42. }
  43. set ::count 0
  44. after 100 report
  45. }
  46.  
  47. report
  48.  
  49. proc start {s} {
  50. puts $s "hi"
  51. flush $s
  52. fileevent $s writable {}
  53. fileevent $s readable "end $s"
  54. }
  55.  
  56. proc end {s} {
  57. read $s
  58. if [eof $s] {
  59. close $s
  60. }
  61. }
  62.  
  63. after 10000 exit
  64.  
  65. while {1} {
  66. set s [socket -async $host $socket]
  67. fconfigure $s -blocking 0
  68. fileevent $s writable "start $s"
  69. puts -nonewline "[incr count] "
  70. evwait 50
  71. }
  72.  
  73.  
  74. vwait forever
  75.