[Bug 2818131] further tests added to cover use of mismatched zlib algorithms

Using zlib gzip to write and inflate to read from a channel where gets
was also used for reading data was causing a crash. This has been
fixed by Andreas' last commit.

1 files changed, 76 insertions, 2 deletions

diff --git a/tests/zlib.test b/tests/zlib.test
index 4903df4..6159e65 100644
--- a/tests/zlib.test
+++ b/tests/zlib.test
@@ -10,7 +10,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: zlib.test,v 1.11 2009/07/10 17:37:19 patthoyts Exp $
+# RCS: @(#) $Id: zlib.test,v 1.12 2010/02/26 00:39:29 patthoyts Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     package require tcltest 2.1
@@ -458,7 +458,7 @@ test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
     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 @@ test zlib-10.1 "bug #2818131 (close with null interp)" -constraints {
     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 0]
+        }
+    }
+    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