summaryrefslogtreecommitdiffstats
path: root/tcl8.6/tests/zlib.test
diff options
context:
space:
mode:
authorWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:47:21 (GMT)
committerWilliam Joye <wjoye@cfa.harvard.edu>2016-12-21 22:47:21 (GMT)
commit5514e37335c012cc70f5b9aee3cedfe3d57f583f (patch)
tree4ba7d8aad13735e52f59bdce7ca5ba3151ebd7e3 /tcl8.6/tests/zlib.test
parent768f87f613cc9789fcf8073018fa02178c8c91df (diff)
downloadblt-5514e37335c012cc70f5b9aee3cedfe3d57f583f.zip
blt-5514e37335c012cc70f5b9aee3cedfe3d57f583f.tar.gz
blt-5514e37335c012cc70f5b9aee3cedfe3d57f583f.tar.bz2
undo subtree
Diffstat (limited to 'tcl8.6/tests/zlib.test')
-rw-r--r--tcl8.6/tests/zlib.test926
1 files changed, 0 insertions, 926 deletions
diff --git a/tcl8.6/tests/zlib.test b/tcl8.6/tests/zlib.test
deleted file mode 100644
index 8a040d8..0000000
--- a/tcl8.6/tests/zlib.test
+++ /dev/null
@@ -1,926 +0,0 @@
-# The file tests the tclZlib.c file.
-#
-# This file contains a collection of tests for one or more of the Tcl built-in
-# commands. Sourcing this file into Tcl runs the tests and generates output
-# for errors. No output means no errors were found.
-#
-# Copyright (c) 1996-1998 by Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-#
-# See the file "license.terms" for information on usage and redistribution of
-# this file, and for a DISCLAIMER OF ALL WARRANTIES.
-
-if {"::tcltest" ni [namespace children]} {
- package require tcltest 2.1
- namespace import -force ::tcltest::*
-}
-
-testConstraint zlib [llength [info commands zlib]]
-testConstraint recentZlib 0
-catch {
- # Work around a bug in some versions of zlib; known to manifest on at
- # least Mac OS X Mountain Lion...
- testConstraint recentZlib \
- [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6]
-}
-
-test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body {
- zlib
-} -result {wrong # args: should be "zlib command arg ?...?"}
-test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body {
- zlib ? {}
-} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream}
-test zlib-1.3 {zlib basics} -constraints zlib -body {
- zlib::pkgconfig list
-} -result zlibVersion
-test zlib-1.4 {zlib basics} -constraints zlib -body {
- package present zlib
-} -result 2.0.1
-
-test zlib-2.1 {zlib compress/decompress} zlib {
- zlib decompress [zlib compress abcdefghijklm]
-} abcdefghijklm
-
-test zlib-3.1 {zlib deflate/inflate} zlib {
- zlib inflate [zlib deflate abcdefghijklm]
-} abcdefghijklm
-
-test zlib-4.1 {zlib gzip/gunzip} zlib {
- zlib gunzip [zlib gzip abcdefghijklm]
-} abcdefghijklm
-test zlib-4.2 {zlib gzip/gunzip} zlib {
- set s [string repeat abcdef 5]
- list [zlib gunzip [zlib gzip $s -header {comment gorp}] -header head] \
- [dict get $head comment] [dict get $head size]
-} {abcdefabcdefabcdefabcdefabcdef gorp 30}
-
-test zlib-5.1 {zlib adler32} zlib {
- format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
-} b3b50b9b
-test zlib-5.2 {zlib adler32} zlib {
- format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
-} b8830bc4
-test zlib-5.3 {zlib adler32} -constraints zlib -returnCodes error -body {
- zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
-} -result {wrong # args: should be "zlib adler32 data ?startValue?"}
-
-test zlib-6.1 {zlib crc32} zlib {
- format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}]
-} 6f73e901
-test zlib-6.2 {zlib crc32} zlib {
- format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}]
-} ce1c4914
-test zlib-6.3 {zlib crc32} -constraints zlib -returnCodes error -body {
- zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42 x
-} -result {wrong # args: should be "zlib crc32 data ?startValue?"}
-test zlib-6.4 {zlib crc32: bug 2662434} -constraints zlib -body {
- zlib crc32 "dabale arroz a la zorra el abad"
-} -result 3842832571
-
-test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup {
- set s [zlib stream compress]
-} -body {
- $s ?
-} -cleanup {
- $s close
-} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset}
-test zlib-7.1 {zlib stream} zlib {
- set s [zlib stream compress]
- $s put -finalize abcdeEDCBA
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result [zlib decompress $data]
-} {{} 136f033f abcdeEDCBA}
-test zlib-7.2 {zlib stream} zlib {
- set s [zlib stream decompress]
- $s put -finalize [zlib compress abcdeEDCBA]
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result $data
-} {{} 136f033f abcdeEDCBA}
-test zlib-7.3 {zlib stream} zlib {
- set s [zlib stream deflate]
- $s put -finalize abcdeEDCBA
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result [zlib inflate $data]
-} {{} 1 abcdeEDCBA}
-test zlib-7.4 {zlib stream} zlib {
- set s [zlib stream inflate]
- $s put -finalize [zlib deflate abcdeEDCBA]
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result $data
-} {{} 1 abcdeEDCBA}
-test zlib-7.5 {zlib stream} zlib {
- set s [zlib stream gzip]
- $s put -finalize abcdeEDCBA..
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result [zlib gunzip $data]
-} {{} 69f34b6a abcdeEDCBA..}
-test zlib-7.6 {zlib stream} zlib {
- set s [zlib stream gunzip]
- $s put -finalize [zlib gzip abcdeEDCBA..]
- set data [$s get]
- set result [list [$s get] [format %x [$s checksum]]]
- $s close
- lappend result $data
-} {{} 69f34b6a abcdeEDCBA..}
-test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body {
- set s [zlib stream deflate]
- $s put {}
-} -cleanup {
- catch {$s close}
-} -result ""
-
-test zlib-8.1 {zlib transformation} -constraints zlib -setup {
- set file [makeFile {} test.gz]
-} -body {
- set f [zlib push gzip [open $file w] -header {comment gorp}]
- puts $f "ok"
- close $f
- set f [zlib push gunzip [open $file]]
- list [gets $f] [dict get [chan configure $f -header] comment]
-} -cleanup {
- close $f
- removeFile $file
-} -result {ok gorp}
-test zlib-8.2 {zlib transformation} -constraints zlib -setup {
- set file [makeFile {} test.z]
-} -body {
- set f [zlib push compress [open $file w]]
- puts $f "ok"
- close $f
- set f [zlib push decompress [open $file]]
- gets $f
-} -cleanup {
- 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 -buffering none -blocking 0
- 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
- after cancel {set total timeout}
- } finally {
- close $sin
- }
- append total --> [file size $file]
-} -cleanup {
- close $fout
- close $srv
- removeFile $file
-} -result 81920-->81920
-test zlib-8.4 {transformation and flushing: Bug 3517696} -setup {
- set file [makeFile {} test.z]
- set fd [open $file w]
-} -constraints zlib -body {
- zlib push compress $fd
- puts $fd "qwertyuiop"
- fconfigure $fd -flush sync
- puts $fd "qwertyuiop"
-} -cleanup {
- catch {close $fd}
- removeFile $file
-} -result {}
-test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup {
- foreach {r w} [chan pipe] break
-} -constraints zlib -body {
- set ::res {}
- fconfigure $w -buffering none
- zlib push compress $w
- puts -nonewline $w qwertyuiop
- chan configure $w -flush sync
- after 500 {puts -nonewline $w asdfghjkl;close $w}
- fconfigure $r -blocking 0 -buffering none
- zlib push decompress $r
- fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}}
- after 250 {lappend ::res MIDDLE}
- vwait ::done
- set ::res
-} -cleanup {
- catch {close $r}
-} -result {qwertyuiop MIDDLE asdfghjkl {}}
-test zlib-8.6 {transformation and fconfigure} -setup {
- set file [makeFile {} test.z]
- set fd [open $file wb]
-} -constraints zlib -body {
- list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \
- [chan pop $fd; fconfigure $fd]
-} -cleanup {
- catch {close $fd}
- removeFile $file
-} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 1 -dictionary {}} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-test zlib-8.7 {transformation and fconfigure} -setup {
- set file [makeFile {} test.gz]
- set fd [open $file wb]
-} -constraints zlib -body {
- list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \
- [chan pop $fd; fconfigure $fd]
-} -cleanup {
- catch {close $fd}
- removeFile $file
-} -result {{-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf -checksum 0} {-blocking 1 -buffering full -buffersize 4096 -encoding binary -eofchar {} -translation lf}}
-# Input is headers from fetching SPDY draft
-# Dictionary is that which is proposed _in_ SPDY draft
-set spdyHeaders "HTTP/1.0 200 OK\r\nContent-Type: text/html; charset=utf-8\r\nX-Robots-Tag: noarchive\r\nLast-Modified: Tue, 05 Jun 2012 02:43:25 GMT\r\nETag: \"1338864205129|#public|0|en|||0\"\r\nExpires: Tue, 05 Jun 2012 16:17:11 GMT\r\nDate: Tue, 05 Jun 2012 16:17:06 GMT\r\nCache-Control: public, max-age=5\r\nX-Content-Type-Options: nosniff\r\nX-XSS-Protection: 1; mode=block\r\nServer: GSE\r\n"
-set spdyDict "optionsgetheadpostputdeletetraceacceptaccept-charsetaccept-encodingaccept-languageauthorizationexpectfromhostif-modified-sinceif-matchif-none-matchif-rangeif-unmodifiedsincemax-forwardsproxy-authorizationrangerefererteuser-agent100101200201202203204205206300301302303304305306307400401402403404405406407408409410411412413414415416417500501502503504505accept-rangesageetaglocationproxy-authenticatepublicretry-afterservervarywarningwww-authenticateallowcontent-basecontent-encodingcache-controlconnectiondatetrailertransfer-encodingupgradeviawarningcontent-languagecontent-lengthcontent-locationcontent-md5content-rangecontent-typeetagexpireslast-modifiedset-cookieMondayTuesdayWednesdayThursdayFridaySaturdaySundayJanFebMarAprMayJunJulAugSepOctNovDecchunkedtext/htmlimage/pngimage/jpgimage/gifapplication/xmlapplication/xhtmltext/plainpublicmax-agecharset=iso-8859-1utf-8gzipdeflateHTTP/1.1statusversionurl"
-test zlib-8.8 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
-} -constraints zlib -body {
- zlib push compress $outSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 1 -translation binary
- puts -nonewline $outSide $spdyHeaders
- chan pop $outSide
- chan close $outSide
- set compressed [read $inSide]
- catch {zlib decompress $compressed} err opt
- list [string length [zlib compress $spdyHeaders]] \
- [string length $compressed] \
- $err [dict get $opt -errorcode] [zlib adler32 $spdyDict]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
-} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010}
-test zlib-8.9 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream decompress]
-} -constraints zlib -body {
- zlib push compress $outSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 1 -translation binary
- puts -nonewline $outSide $spdyHeaders
- set result [fconfigure $outSide -checksum]
- chan pop $outSide
- chan close $outSide
- $strm put -dictionary $spdyDict [read $inSide]
- lappend result [string length $spdyHeaders] [string length [$strm get]]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {3064818174 358 358}
-test zlib-8.10 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
-} -constraints {zlib recentZlib} -body {
- zlib push deflate $outSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 1 -translation binary
- puts -nonewline $outSide $spdyHeaders
- chan pop $outSide
- chan close $outSide
- set compressed [read $inSide]
- catch {
- zlib inflate $compressed
- throw UNREACHABLE "should be unreachable"
- } err opt
- list [string length [zlib deflate $spdyHeaders]] \
- [string length $compressed] \
- $err [dict get $opt -errorcode]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
-} -result {254 212 {data error} {TCL ZLIB DATA}}
-test zlib-8.11 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream inflate]
-} -constraints zlib -body {
- zlib push deflate $outSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -translation binary -buffering none
- fconfigure $inSide -blocking 1 -translation binary
- puts -nonewline $outSide $spdyHeaders
- chan pop $outSide
- chan close $outSide
- $strm put -dictionary $spdyDict [read $inSide]
- list [string length $spdyHeaders] [string length [$strm get]]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {358 358}
-test zlib-8.12 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream compress]
-} -constraints zlib -body {
- $strm put -dictionary $spdyDict -finalize $spdyHeaders
- zlib push decompress $inSide
- fconfigure $outSide -blocking 0 -translation binary
- fconfigure $inSide -translation binary -dictionary $spdyDict
- puts -nonewline $outSide [$strm get]
- close $outSide
- list [string length $spdyHeaders] [string length [read $inSide]] \
- [fconfigure $inSide -checksum]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {358 358 3064818174}
-test zlib-8.13 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream compress]
-} -constraints zlib -body {
- $strm put -dictionary $spdyDict -finalize $spdyHeaders
- zlib push decompress $inSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -translation binary
- fconfigure $inSide -translation binary
- puts -nonewline $outSide [$strm get]
- close $outSide
- list [string length $spdyHeaders] [string length [read $inSide]] \
- [fconfigure $inSide -checksum]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {358 358 3064818174}
-test zlib-8.14 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream deflate]
-} -constraints zlib -body {
- $strm put -finalize -dictionary $spdyDict $spdyHeaders
- zlib push inflate $inSide
- fconfigure $outSide -blocking 0 -buffering none -translation binary
- fconfigure $inSide -translation binary -dictionary $spdyDict
- puts -nonewline $outSide [$strm get]
- close $outSide
- list [string length $spdyHeaders] [string length [read $inSide]]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {358 358}
-test zlib-8.15 {transformation and fconfigure} -setup {
- lassign [chan pipe] inSide outSide
- set strm [zlib stream deflate]
-} -constraints zlib -body {
- $strm put -finalize -dictionary $spdyDict $spdyHeaders
- zlib push inflate $inSide -dictionary $spdyDict
- fconfigure $outSide -blocking 0 -buffering none -translation binary
- fconfigure $inSide -translation binary
- puts -nonewline $outSide [$strm get]
- close $outSide
- list [string length $spdyHeaders] [string length [read $inSide]]
-} -cleanup {
- catch {close $outSide}
- catch {close $inSide}
- catch {$strm close}
-} -result {358 358}
-test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup {
- # Actual data isn't very important; needs to be substantially larger than
- # the internal buffer (32kB) and incompressible.
- set largeData {}
- for {set i 0;expr srand(1)} {$i < 100000} {incr i} {
- append largeData [lindex "a b c d e f g h i j k l m n o p" \
- [expr {int(16*rand())}]]
- }
- set file [makeFile {} test.gz]
-} -constraints zlib -body {
- set f [open $file wb]
- fconfigure $f -buffering none
- zlib push gzip $f
- puts -nonewline $f $largeData
- close $f
- file size $file
-} -cleanup {
- removeFile $file
-} -result 57647
-test zlib-8.17 {Bug dd260aaf: fconfigure} -setup {
- lassign [chan pipe] inSide outSide
-} -constraints zlib -body {
- zlib push inflate $inSide
- zlib push deflate $outSide
- list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
-} -cleanup {
- catch {close $inSide}
- catch {close $outSide}
-} -result {{} {}}
-test zlib-8.18 {Bug dd260aaf: fconfigure} -setup {
- lassign [chan pipe] inSide outSide
-} -constraints zlib -body {
- zlib push inflate $inSide -dictionary "one two"
- zlib push deflate $outSide -dictionary "one two"
- list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary]
-} -cleanup {
- catch {close $inSide}
- catch {close $outSide}
-} -result {{one two} {one two}}
-
-test zlib-9.1 "check fcopy with push" -constraints zlib -setup {
- set sfile [makeFile {} testsrc.gz]
- set file [makeFile {} test.gz]
- set f [open $sfile wb]
- puts -nonewline $f [zlib gzip [string repeat a 81920]]
- close $f
-} -body {
- set fin [zlib push gunzip [open $sfile rb]]
- set fout [open $file wb]
- set total [fcopy $fin $fout]
- close $fin ; close $fout
- list copied $total size [file size $file]
-} -cleanup {
- removeFile $file
- removeFile $sfile
-} -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 -translation binary -buffering none -blocking 0
- puts -nonewline $c [zlib gzip [string repeat a 81920]]
- close $c
- }}} 0]
- set file [makeFile {} test.gz]
-} -body {
- lassign [chan configure $srv -sockname] addr name port
- set sin [socket $addr $port]
- chan configure $sin -translation binary
- zlib push gunzip $sin
- update
- set total [fcopy $sin [set fout [open $file wb]]]
- close $sin
- close $fout
- list read $total size [file size $file]
-} -cleanup {
- close $srv
- removeFile $file
-} -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"
- chan configure $c -translation binary -buffering none -blocking 0
- puts -nonewline $c [string repeat a 81920]
- close $c
- }}} 0]
- set file [makeFile {} test.gz]
-} -body {
- lassign [chan configure $srv -sockname] addr name port
- #puts "listening for connections on $addr $port"
- set sin [socket localhost $port]
- chan configure $sin -translation binary
- update
- set fout [open $file wb]
- after 1000 {set ::total timeout}
- fcopy $sin $fout -command {apply {{c {e {}}} {
- set ::total [expr {$e eq {} ? $c : $e}]
- }}}
- vwait ::total
- after cancel {set ::total timeout}
- close $sin; close $fout
- list read $::total size [file size $file]
-} -cleanup {
- close $srv
- removeFile $file
-} -returnCodes {ok error} -result {read 81920 size 81920}
-test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup {
- set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none -blocking 0
- puts -nonewline $c [zlib gzip [string repeat a 81920]]
- close $c
- }}} 0]
- set file [makeFile {} test.gz]
-} -body {
- lassign [chan configure $srv -sockname] addr name port
- set sin [socket $addr $port]
- chan configure $sin -translation binary
- zlib push gunzip $sin
- update
- set fout [open $file wb]
- after 1000 {set ::total timeout}
- fcopy $sin $fout -command {apply {{c {e {}}} {
- set ::total [expr {$e eq {} ? $c : $e}]
- }}}
- vwait ::total
- after cancel {set ::total timeout}
- close $sin; close $fout
- list read $::total size [file size $file]
-} -cleanup {
- close $srv
- removeFile $file
-} -result {read 81920 size 81920}
-test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup {
- set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none -blocking 0
- puts -nonewline $c [zlib gzip [string repeat a 81920]]
- close $c
- }}} 0]
- proc zlib95copy {i o t c {e {}}} {
- incr t $c
- if {$e ne {}} {
- set ::total [list error $e]
- } elseif {[eof $i]} {
- set ::total [list eof $t]
- } else {
- fcopy $i $o -size 8192 -command [list zlib95copy $i $o $t]
- }
- }
- set file [makeFile {} test.gz]
-} -body {
- lassign [chan configure $srv -sockname] addr name port
- set sin [socket $addr $port]
- chan configure $sin -translation binary
- zlib push gunzip $sin
- update
- set fout [open $file wb]
- after 1000 {set ::total timeout}
- fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0]
- vwait ::total
- after cancel {set ::total timeout}
- close $sin; close $fout
- list $::total size [file size $file]
-} -cleanup {
- close $srv
- rename zlib95copy {}
- removeFile $file
-} -result {{eof 81920} size 81920}
-test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup {
- set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none -blocking 0
- 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]
- chan configure $s -translation binary
- 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
- after cancel {set ::total timeout}
- close $s
- set ::total
-} -cleanup {
- close $srv
- unset -nocomplain total
-} -result {eof 500}
-test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup {
- set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none -blocking 0
- 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]
- chan configure $s -translation binary
- zlib push decompress $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
- after cancel {set ::total timeout}
- close $s
- set ::total
-} -cleanup {
- close $srv
- unset -nocomplain total
-} -result {eof 500}
-test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup {
- set srv [socket -myaddr localhost -server {apply {{c a p} {
- chan configure $c -translation binary -buffering none -blocking 0
- 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
- 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
- after cancel {set ::total timeout}
- 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 -blocking 0
- 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
- 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 {
- after cancel {set ::total timeout}
- 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 -blocking 0
- 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
- 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 {
- after cancel {set ::total timeout}
- 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 -blocking 0
- 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]
- try {
- chan configure $s -translation binary
- 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 {
- after cancel {set ::total timeout}
- close $s
- }
- set ::total
-} -cleanup {
- unset -nocomplain total
- close $srv
- rename bgerror {}
-} -result {error {incorrect header check}}
-
-test zlib-10.0 "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
- 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 -blocking 0
- 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
- after cancel {set ::total timeout}
- after cancel {set ::total done}
- set ::total
-} -cleanup {
- close $srv
- 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
- 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 -blocking 0
- 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
- after cancel {set ::total timeout}
- after cancel {set ::total done}
- 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
- 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 -blocking 0
- 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
- after cancel {set ::total timeout}
- after cancel {set ::total done}
- set ::total
-} -cleanup {
- close $srv
- rename bgerror {}
- rename zlibRead {}
-} -result {error {invalid block type}}
-
-test zlib-11.1 "Bug #3390073: mis-appled gzip filtering" -setup {
- set file [makeFile {} test.input]
-} -constraints zlib -body {
- set f [open $file wb]
- puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000]
- close $f
- set f [open $file rb]
- set d [read $f]
- close $f
- set d [zlib gunzip $d]
- list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]]
-} -cleanup {
- removeFile $file
-} -result {1000 0}
-test zlib-11.2 "Bug #3390073: mis-appled gzip filtering" -setup {
- set file [makeFile {} test.input]
-} -constraints zlib -body {
- set f [open $file wb]
- puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
- [string repeat "hello" 1000]
- close $f
- set f [open $file rb]
- set d [read $f]
- close $f
- set d [zlib gunzip $d -header h]
- list [regexp -all "hello" $d] [dict get $h filename] \
- [string length [regsub -all "hello" $d {}]]
-} -cleanup {
- removeFile $file
-} -result {1000 /foo/bar 0}
-test zlib-11.3 {Bug 3595576 variant} -setup {
- set file [makeFile {} test.input]
-} -constraints zlib -body {
- set f [open $file wb]
- puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \
- [string repeat "hello" 1000]
- close $f
- set f [open $file rb]
- set d [read $f]
- close $f
- zlib gunzip $d -header noSuchNs::foo
-} -cleanup {
- removeFile $file
-} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist}
-
-test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup {
- set stream [zlib stream compress]
-} -body {
- for {set opts {};set y 0} {$y < 60} {incr y} {
- for {set line {};set x 0} {$x < 100} {incr x} {
- append line [binary format ccc $x $y 128]
- }
- if {$y == 59} {
- set opts -finalize
- }
- $stream put {*}$opts $line
- }
- set data [$stream get]
- list [string length $data] [string length [zlib decompress $data]]
-} -cleanup {
- $stream close
-} -result {12026 18000}
-
-::tcltest::cleanupTests
-return
-
-# Local Variables:
-# mode: tcl
-# End: