Posted to tcl by patthoyts at Thu Oct 01 00:05:42 GMT 2009view raw
- 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