summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
authorpatthoyts <patthoyts@users.sourceforge.net>2009-07-10 17:37:18 (GMT)
committerpatthoyts <patthoyts@users.sourceforge.net>2009-07-10 17:37:18 (GMT)
commitb1b828fd60bfd07a6e17453f3d2ffe646bcad60c (patch)
tree8f3fe2fe7cb2e4309ee617233cd7d2a53f25e035 /tests
parent02ba54c693aaea66388d4d5293c510e999209910 (diff)
downloadtcl-b1b828fd60bfd07a6e17453f3d2ffe646bcad60c.zip
tcl-b1b828fd60bfd07a6e17453f3d2ffe646bcad60c.tar.gz
tcl-b1b828fd60bfd07a6e17453f3d2ffe646bcad60c.tar.bz2
ZlibTransformClose may be called with a NULL interpreter during finalization and
Tcl_SetChannelError requires a list. Added some tests to ensure error propagation from the zlib library to the interp.
Diffstat (limited to 'tests')
-rw-r--r--tests/zlib.test204
1 files changed, 168 insertions, 36 deletions
diff --git a/tests/zlib.test b/tests/zlib.test
index 3705419..4903df4 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.10 2009/07/09 22:48:44 patthoyts Exp $
+# RCS: @(#) $Id: zlib.test,v 1.11 2009/07/10 17:37:19 patthoyts Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
package require tcltest 2.1
@@ -173,7 +173,7 @@ test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
} -cleanup {
removeFile $file
removeFile $sfile
-} -returnCodes {ok} -result {copied 81920 size 81920}
+} -result {copied 81920 size 81920}
test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
chan configure $c -encoding binary -translation binary
@@ -194,10 +194,10 @@ test zlib-9.2 "socket fcopy with push" -constraints zlib -setup {
} -cleanup {
close $srv
removeFile $file
-} -returnCodes {ok error} -result {read 81920 size 81920}
-test zlib-9.3 "socket fcopy bg (identity)" -constraints zlib -setup {
+} -result {read 81920 size 81920}
+test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup {
set srv [socket -myaddr localhost -server {apply {{c a p} {
- puts "connection from $a:$p on $c"
+ #puts "connection from $a:$p on $c"
chan configure $c -encoding binary -translation binary
puts -nonewline $c [string repeat a 81920]
close $c
@@ -205,7 +205,7 @@ test zlib-9.3 "socket fcopy bg (identity)" -constraints zlib -setup {
set file [makeFile {} test.gz]
} -body {
lassign [chan configure $srv -sockname] addr name port
- puts "listening for connections on $addr $port"
+ #puts "listening for connections on $addr $port"
set sin [socket localhost $port]
chan configure $sin -translation binary
update
@@ -280,15 +280,7 @@ test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
rename zlib95copy {}
removeFile $file
} -result {{eof 81920} size 81920}
-
test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
- proc zlib96read {c} {
- set d [read $c]
- if {[eof $c]} {
- chan event $c readable {}
- 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 gzip $c
@@ -301,22 +293,21 @@ test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
set s [socket $addr $port]
chan configure $s -translation binary -buffering none
zlib push gunzip $s
- chan event $s readable [list zlib96read $s]
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
+ set ::total [list eof [string length $d]]
+ }
+ }} $s]
vwait ::total
close $s
set ::total
} -cleanup {
close $srv
- rename zlib96read {}
-} -returnCodes {ok error} -result {eof 500}
+ unset -nocomplain total
+} -result {eof 500}
test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
- proc zlib97read {c} {
- set d [read $c]
- if {[eof $c]} {
- chan event $c readable {}
- 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 compress $c
@@ -329,22 +320,113 @@ test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
set s [socket $addr $port]
chan configure $s -translation binary -buffering none
zlib push decompress $s
- chan event $s readable [list zlib97read $s]
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
+ set ::total [list eof [string length $d]]
+ }
+ }} $s]
vwait ::total
close $s
set ::total
} -cleanup {
close $srv
- rename zlib97read {}
-} -returnCodes {ok error} -result {eof 500}
+ unset -nocomplain total
+} -result {eof 500}
test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
- proc zlib98read {c} {
- set d [read $c]
- if {[eof $c]} {
- chan event $c readable {}
+ set srv [socket -myaddr localhost -server {apply {{c a p} {
+ chan configure $c -translation binary -buffering none
+ zlib push deflate $c
+ puts -nonewline $c [string repeat hello 100]
+ close $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 inflate $s
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
set ::total [list eof [string length $d]]
}
+ }} $s]
+ vwait ::total
+ close $s
+ set ::total
+} -cleanup {
+ unset -nocomplain total
+ close $srv
+} -result {eof 500}
+test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup {
+ proc bgerror {s} {set ::total [list error $s]}
+ set srv [socket -myaddr localhost -server {apply {{c a p} {
+ chan configure $c -translation binary -buffering none
+ zlib push gzip $c
+ puts -nonewline $c [string repeat hello 100]
+ close $c
+ }}} 0]
+} -body {
+ lassign [chan configure $srv -sockname] addr name port
+ after 1000 {set ::total timeout}
+ set s [socket $addr $port]
+ try {
+ chan configure $s -translation binary -buffering none
+ zlib push inflate $s
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
+ set ::total [list eof [string length $d]]
+ }
+ }} $s]
+ vwait ::total
+ } finally {
+ close $s
}
+ set ::total
+} -cleanup {
+ unset -nocomplain total
+ close $srv
+ rename bgerror {}
+} -result {error {invalid block type}}
+test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup {
+ proc bgerror {s} {set ::total [list error $s]}
+ set srv [socket -myaddr localhost -server {apply {{c a p} {
+ chan configure $c -translation binary -buffering none
+ zlib push compress $c
+ puts -nonewline $c [string repeat hello 100]
+ close $c
+ }}} 0]
+} -body {
+ lassign [chan configure $srv -sockname] addr name port
+ after 1000 {set ::total timeout}
+ set s [socket $addr $port]
+ try {
+ chan configure $s -translation binary -buffering none
+ zlib push inflate $s
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
+ set ::total [list eof [string length $d]]
+ }
+ }} $s]
+ vwait ::total
+ } finally {
+ close $s
+ }
+ set ::total
+} -cleanup {
+ unset -nocomplain total
+ close $srv
+ rename bgerror {}
+} -result {error {invalid stored block lengths}}
+test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup {
+ proc bgerror {s} {set ::total [list error $s]}
set srv [socket -myaddr localhost -server {apply {{c a p} {
chan configure $c -translation binary -buffering none
zlib push deflate $c
@@ -355,16 +437,66 @@ test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
lassign [chan configure $srv -sockname] addr name port
after 1000 {set ::total timeout}
set s [socket $addr $port]
+ try {
+ chan configure $s -translation binary -buffering none
+ zlib push gunzip $s
+ chan event $s readable [list apply {{s} {
+ set d [read $s]
+ if {[eof $s]} {
+ chan event $s readable {}
+ set ::total [list eof [string length $d]]
+ }
+ }} $s]
+ vwait ::total
+ } finally {
+ close $s
+ }
+ set ::total
+} -cleanup {
+ unset -nocomplain total
+ close $srv
+ rename bgerror {}
+} -result {error {incorrect header check}}
+
+test zlib-10.1 "bug #2818131 (close with null interp)" -constraints {
+ zlib
+} -setup {
+ proc bgerror {s} {set ::total [list error $s]}
+ 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 apply {{c} {
+ set d [read $c]
+ if {[eof $c]} {
+ chan event $c readable {}
+ close $c
+ set ::total [list eof [string length $d]]
+ }
+ }} $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 inflate $s
- chan event $s readable [list zlib98read $s]
+ zlib push gzip $s
+ chan event $s xyzzy [list apply {{s} {
+ if {[gets $s line] < 0} {
+ chan close $s
+ }
+ }} $s]
+ after idle [list apply {{s} {
+ puts $s test
+ chan close $s
+ after 100 {set ::total done}
+ }} $s]
vwait ::total
- close $s
set ::total
} -cleanup {
close $srv
- rename zlib98read {}
-} -returnCodes {ok error} -result {eof 500}
+ rename bgerror {}
+} -returnCodes error \
+ -result {bad event name "xyzzy": must be readable or writable}
::tcltest::cleanupTests
return