Posted to tcl by patthoyts at Mon Feb 22 23:07:39 GMT 2010view raw

  1. test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints {
  2. zlib
  3. } -setup {
  4. proc bgerror {s} {set ::total [list error $s]}
  5. proc zlibRead {c} {
  6. if {[gets $c line] < 0} {
  7. close $c
  8. set ::total [list error -1]
  9. } elseif {[eof $c]} {
  10. chan event $c readable {}
  11. close $c
  12. set ::total [list eof [string length $d]]
  13. }
  14. }
  15. set srv [socket -myaddr localhost -server {apply {{c a p} {
  16. chan configure $c -translation binary -buffering none
  17. zlib push inflate $c
  18. chan event $c readable [list zlibRead $c]
  19. }}} 0]
  20. } -body {
  21. lassign [chan configure $srv -sockname] addr name port
  22. after 1000 {set ::total timeout}
  23. set s [socket $addr $port]
  24. chan configure $s -translation binary -buffering none
  25. zlib push gzip $s
  26. chan event $s readable [list zlibRead $s]
  27. after idle [list apply {{s} {
  28. puts $s test
  29. chan close $s
  30. after 100 {set ::total done}
  31. }} $s]
  32. vwait ::total
  33. set ::total
  34. } -cleanup {
  35. close $srv
  36. rename bgerror {}
  37. rename zlibRead {}
  38. } -result {error {invalid block type}}
  39.