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