Posted to tcl by patthoyts at Mon Feb 22 23:07:39 GMT 2010view pretty
test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints { zlib } -setup { proc bgerror {s} {set ::total [list error $s]} proc zlibRead {c} { if {[gets $c line] < 0} { close $c set ::total [list error -1] } elseif {[eof $c]} { chan event $c readable {} close $c set ::total [list eof [string length $d]] } } set srv [socket -myaddr localhost -server {apply {{c a p} { chan configure $c -translation binary -buffering none zlib push inflate $c chan event $c readable [list zlibRead $c] }}} 0] } -body { lassign [chan configure $srv -sockname] addr name port after 1000 {set ::total timeout} set s [socket $addr $port] chan configure $s -translation binary -buffering none zlib push gzip $s chan event $s readable [list zlibRead $s] after idle [list apply {{s} { puts $s test chan close $s after 100 {set ::total done} }} $s] vwait ::total set ::total } -cleanup { close $srv rename bgerror {} rename zlibRead {} } -result {error {invalid block type}}