diff options
author | dkf <dkf@noemail.net> | 2009-07-05 16:05:55 (GMT) |
---|---|---|
committer | dkf <dkf@noemail.net> | 2009-07-05 16:05:55 (GMT) |
commit | 19cfb5f9d8516890d01d6bc719b15356e7547e09 (patch) | |
tree | 17716b7829ca21bf5566d58a517f5d0441e8db29 /tests/zlib.test | |
parent | 94bf14cbe08012aca6f65cf1dfa62ed4d764b713 (diff) | |
download | tcl-19cfb5f9d8516890d01d6bc719b15356e7547e09.zip tcl-19cfb5f9d8516890d01d6bc719b15356e7547e09.tar.gz tcl-19cfb5f9d8516890d01d6bc719b15356e7547e09.tar.bz2 |
Make [zlib push] work with [fcopy].
FossilOrigin-Name: 03d972d6d9c0fbe597a0e6d7b89a95d4931a5ff2
Diffstat (limited to 'tests/zlib.test')
-rw-r--r-- | tests/zlib.test | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/tests/zlib.test b/tests/zlib.test index 41599a6..dae1861 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.7 2009/03/04 17:26:24 dkf Exp $ +# RCS: @(#) $Id: zlib.test,v 1.8 2009/07/05 16:05:59 dkf Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { package require tcltest 2.1 @@ -130,6 +130,34 @@ test zlib-8.2 {zlib transformation} -constraints zlib -setup { close $f removeFile $file } -result ok +test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup { + set srv [socket -myaddr localhost -server {apply {{c a p} { + fconfigure $c -translation binary + puts -nonewline $c [zlib gzip [string repeat a 81920]] + close $c + }}} 0] + set port [lindex [fconfigure $srv -sockname] 2] + set file [makeFile {} test.gz] + set fout [open $file wb] +} -body { + set sin [socket localhost $port] + try { + fconfigure $sin -translation binary + zlib push gunzip $sin + after 1000 {set total timeout} + fcopy $sin $fout -command {apply {{c {e {}}} { + set ::total [expr {$e eq {} ? $c : $e}] + }}} + vwait total + } finally { + close $sin + } + append total --> [file size $file] +} -cleanup { + close $fout + close $srv + removeFile $file +} -result 81920-->81920 ::tcltest::cleanupTests return |