# 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]] 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-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-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}} test zlib-8.8 {transformtion and fconfigure} -setup { lassign [chan pipe] inSide outSide set msg [string repeat "am i all that i am at all? i am all that i am!" 400] set dict "thatallam i " } -constraints zlib -body { zlib push compress $outSide -dictionary $dict fconfigure $outSide -blocking 0 -translation binary -buffering none fconfigure $inSide -blocking 0 -translation binary puts -nonewline $outSide $msg chan pop $outSide string length [read $inSide] } -cleanup { catch {close $outSide} catch {close $inSide} } -result 103 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} ::tcltest::cleanupTests return # Local Variables: # mode: tcl # End: