Posted to tcl by patthoyts at Thu Oct 01 00:05:42 GMT 2009view pretty
Index: tests/zlib.test =================================================================== RCS file: /cvsroot/tcl/tcl/tests/zlib.test,v retrieving revision 1.11 diff -u -r1.11 zlib.test --- tests/zlib.test 10 Jul 2009 17:37:19 -0000 1.11 +++ tests/zlib.test 13 Jul 2009 10:00:45 -0000 @@ -458,7 +458,7 @@ rename bgerror {} } -result {error {incorrect header check}} -test zlib-10.1 "bug #2818131 (close with null interp)" -constraints { +test zlib-10.0 "bug #2818131 (close with null interp)" -constraints { zlib } -setup { proc bgerror {s} {set ::total [list error $s]} @@ -497,6 +497,80 @@ rename bgerror {} } -returnCodes error \ -result {bad event name "xyzzy": must be readable or writable} +test zlib-10.1 "bug #2818131 (mismatch read)" -constraints { + zlib +} -setup { + proc bgerror {s} {set ::total [list error $s]} + proc zlibRead {c} { + set d [read $c] + if {[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}} +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}} ::tcltest::cleanupTests return