1# The file tests the tclZlib.c file. 2# 3# This file contains a collection of tests for one or more of the Tcl built-in 4# commands. Sourcing this file into Tcl runs the tests and generates output 5# for errors. No output means no errors were found. 6# 7# Copyright © 1996-1998 Sun Microsystems, Inc. 8# Copyright © 1998-1999 Scriptics Corporation. 9# 10# See the file "license.terms" for information on usage and redistribution of 11# this file, and for a DISCLAIMER OF ALL WARRANTIES. 12 13if {"::tcltest" ni [namespace children]} { 14 package require tcltest 2.5 15 namespace import -force ::tcltest::* 16} 17 18testConstraint zlib [llength [info commands zlib]] 19testConstraint recentZlib 0 20catch { 21 # Work around a bug in some versions of zlib; known to manifest on at 22 # least Mac OS X Mountain Lion... 23 testConstraint recentZlib \ 24 [package vsatisfies [zlib::pkgconfig get zlibVersion] 1.2.6] 25} 26 27test zlib-1.1 {zlib basics} -constraints zlib -returnCodes error -body { 28 zlib 29} -result {wrong # args: should be "zlib command arg ?...?"} 30test zlib-1.2 {zlib basics} -constraints zlib -returnCodes error -body { 31 zlib ? {} 32} -result {bad command "?": must be adler32, compress, crc32, decompress, deflate, gunzip, gzip, inflate, push, or stream} 33test zlib-1.3 {zlib basics} -constraints zlib -body { 34 zlib::pkgconfig list 35} -result zlibVersion 36test zlib-1.4 {zlib basics} -constraints zlib -body { 37 package present tcl::zlib 38} -result 2.0.1 39 40test zlib-2.1 {zlib compress/decompress} zlib { 41 zlib decompress [zlib compress abcdefghijklm] 42} abcdefghijklm 43 44test zlib-3.1 {zlib deflate/inflate} zlib { 45 zlib inflate [zlib deflate abcdefghijklm] 46} abcdefghijklm 47 48test zlib-4.1 {zlib gzip/gunzip} zlib { 49 zlib gunzip [zlib gzip abcdefghijklm] 50} abcdefghijklm 51test zlib-4.2 {zlib gzip/gunzip} zlib { 52 set s [string repeat abcdef 5] 53 list [zlib gunzip [zlib gzip $s -header {comment gorp}] -header head] \ 54 [dict get $head comment] [dict get $head size] 55} {abcdefabcdefabcdefabcdefabcdef gorp 30} 56 57test zlib-5.1 {zlib adler32} zlib { 58 format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}] 59} b3b50b9b 60test zlib-5.2 {zlib adler32} zlib { 61 format %x [expr {[zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}] 62} b8830bc4 63test zlib-5.3 {zlib adler32} -constraints zlib -returnCodes error -body { 64 zlib adler32 abcdeabcdeabcdeabcdeabcdeabcde 42 x 65} -result {wrong # args: should be "zlib adler32 data ?startValue?"} 66 67test zlib-6.1 {zlib crc32} zlib { 68 format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde] & 0xffffffff}] 69} 6f73e901 70test zlib-6.2 {zlib crc32} zlib { 71 format %x [expr {[zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42] & 0xffffffff}] 72} ce1c4914 73test zlib-6.3 {zlib crc32} -constraints zlib -returnCodes error -body { 74 zlib crc32 abcdeabcdeabcdeabcdeabcdeabcde 42 x 75} -result {wrong # args: should be "zlib crc32 data ?startValue?"} 76test zlib-6.4 {zlib crc32: bug 2662434} -constraints zlib -body { 77 zlib crc32 "dabale arroz a la zorra el abad" 78} -result 3842832571 79 80test zlib-7.0 {zlib stream} -constraints zlib -returnCodes error -setup { 81 set s [zlib stream compress] 82} -body { 83 $s ? 84} -cleanup { 85 $s close 86} -result {bad option "?": must be add, checksum, close, eof, finalize, flush, fullflush, get, header, put, or reset} 87test zlib-7.1 {zlib stream} zlib { 88 set s [zlib stream compress] 89 $s put -finalize abcdeEDCBA 90 set data [$s get] 91 set result [list [$s get] [format %x [$s checksum]]] 92 $s close 93 lappend result [zlib decompress $data] 94} {{} 136f033f abcdeEDCBA} 95test zlib-7.2 {zlib stream} zlib { 96 set s [zlib stream decompress] 97 $s put -finalize [zlib compress abcdeEDCBA] 98 set data [$s get] 99 set result [list [$s get] [format %x [$s checksum]]] 100 $s close 101 lappend result $data 102} {{} 136f033f abcdeEDCBA} 103test zlib-7.3 {zlib stream} zlib { 104 set s [zlib stream deflate] 105 $s put -finalize abcdeEDCBA 106 set data [$s get] 107 set result [list [$s get] [format %x [$s checksum]]] 108 $s close 109 lappend result [zlib inflate $data] 110} {{} 1 abcdeEDCBA} 111test zlib-7.4 {zlib stream} zlib { 112 set s [zlib stream inflate] 113 $s put -finalize [zlib deflate abcdeEDCBA] 114 set data [$s get] 115 set result [list [$s get] [format %x [$s checksum]]] 116 $s close 117 lappend result $data 118} {{} 1 abcdeEDCBA} 119test zlib-7.5 {zlib stream} zlib { 120 set s [zlib stream gzip] 121 $s put -finalize abcdeEDCBA.. 122 set data [$s get] 123 set result [list [$s get] [format %x [$s checksum]]] 124 $s close 125 lappend result [zlib gunzip $data] 126} {{} 69f34b6a abcdeEDCBA..} 127test zlib-7.6 {zlib stream} zlib { 128 set s [zlib stream gunzip] 129 $s put -finalize [zlib gzip abcdeEDCBA..] 130 set data [$s get] 131 set result [list [$s get] [format %x [$s checksum]]] 132 $s close 133 lappend result $data 134} {{} 69f34b6a abcdeEDCBA..} 135test zlib-7.7 {zlib stream: Bug 25842c161} -constraints zlib -body { 136 set s [zlib stream deflate] 137 $s put {} 138} -cleanup { 139 catch {$s close} 140} -result "" 141# Also causes Tk Bug 10f2e7872b 142test zlib-7.8 {zlib stream: Bug b26e38a3e4} -constraints zlib -setup { 143 expr {srand(12345)} 144 set randdata {} 145 for {set i 0} {$i<6001} {incr i} { 146 append randdata [binary format c [expr {int(256*rand())}]] 147 } 148} -body { 149 set strm [zlib stream compress] 150 for {set i 1} {$i<3000} {incr i} { 151 $strm put $randdata 152 } 153 $strm put -finalize $randdata 154 set data [$strm get] 155 list [string length $data] [string length [zlib decompress $data]] 156} -cleanup { 157 catch {$strm close} 158 unset -nocomplain randdata data 159} -result {120185 18003000} 160test zlib-7.9 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { 161 set z1 [zlib stream gzip] 162 set z2 [zlib stream gzip] 163} -body { 164 $z1 put ABCDEedbca.. 165 $z1 finalize 166 zlib gunzip [$z1 get] 167} -cleanup { 168 $z1 close 169} -result ABCDEedbca.. 170test zlib-7.10 {zlib stream finalize (bug 25842c161)} -constraints zlib -setup { 171 set z2 [zlib stream gzip] 172} -body { 173 $z2 put -finalize ABCDEedbca.. 174 zlib gunzip [$z2 get] 175} -cleanup { 176 $z2 close 177} -result ABCDEedbca.. 178test zlib-7.11 {zlib stream put -finalize (bug 25842c161)} -constraints zlib -setup { 179 set c [zlib stream gzip] 180 set d [zlib stream gunzip] 181} -body { 182 $c put abcdeEDCBA.. 183 $c finalize 184 $d put [$c get] 185 $d finalize 186 $d get 187} -cleanup { 188 $c close 189 $d close 190} -result abcdeEDCBA.. 191test zlib-7.12 {zlib stream put; zlib stream finalize (bug 25842c161)} -constraints zlib -setup { 192 set c [zlib stream gzip] 193 set d [zlib stream gunzip] 194} -body { 195 $c put -finalize abcdeEDCBA.. 196 $d put -finalize [$c get] 197 $d get 198} -cleanup { 199 $c close 200 $d close 201} -result abcdeEDCBA.. 202 203test zlib-8.1 {zlib transformation} -constraints zlib -setup { 204 set file [makeFile {} test.gz] 205} -body { 206 set f [zlib push gzip [open $file w] -header {comment gorp}] 207 puts $f "ok" 208 close $f 209 set f [zlib push gunzip [open $file]] 210 list [gets $f] [dict get [chan configure $f -header] comment] 211} -cleanup { 212 close $f 213 removeFile $file 214} -result {ok gorp} 215test zlib-8.2 {zlib transformation} -constraints zlib -setup { 216 set file [makeFile {} test.z] 217} -body { 218 set f [zlib push compress [open $file w]] 219 puts $f "ok" 220 close $f 221 set f [zlib push decompress [open $file]] 222 gets $f 223} -cleanup { 224 close $f 225 removeFile $file 226} -result ok 227test zlib-8.3 {zlib transformation and fileevent} -constraints zlib -setup { 228 set srv [socket -myaddr localhost -server {apply {{c a p} { 229 fconfigure $c -translation binary -buffering none -blocking 0 230 puts -nonewline $c [zlib gzip [string repeat a 81920]] 231 close $c 232 }}} 0] 233 set port [lindex [fconfigure $srv -sockname] 2] 234 set file [makeFile {} test.gz] 235 set fout [open $file wb] 236} -body { 237 set sin [socket localhost $port] 238 try { 239 fconfigure $sin -translation binary 240 zlib push gunzip $sin 241 after 1000 {set total timeout} 242 fcopy $sin $fout -command {apply {{c {e {}}} { 243 set ::total [expr {$e eq {} ? $c : $e}] 244 }}} 245 vwait total 246 after cancel {set total timeout} 247 } finally { 248 close $sin 249 } 250 append total --> [file size $file] 251} -cleanup { 252 close $fout 253 close $srv 254 removeFile $file 255} -result 81920-->81920 256test zlib-8.4 {transformation and flushing: Bug 3517696} -setup { 257 set file [makeFile {} test.z] 258 set fd [open $file w] 259} -constraints zlib -body { 260 zlib push compress $fd 261 puts $fd "qwertyuiop" 262 fconfigure $fd -flush sync 263 puts $fd "qwertyuiop" 264} -cleanup { 265 catch {close $fd} 266 removeFile $file 267} -result {} 268test zlib-8.5 {transformation and flushing and fileevents: Bug 3525907} -setup { 269 foreach {r w} [chan pipe] break 270} -constraints zlib -body { 271 set ::res {} 272 fconfigure $w -buffering none 273 zlib push compress $w 274 puts -nonewline $w qwertyuiop 275 chan configure $w -flush sync 276 after 500 {puts -nonewline $w asdfghjkl;close $w} 277 fconfigure $r -blocking 0 -buffering none 278 zlib push decompress $r 279 fileevent $r readable {set msg [read $r];lappend ::res $msg;if {[eof $r]} {set ::done 1}} 280 after 250 {lappend ::res MIDDLE} 281 vwait ::done 282 set ::res 283} -cleanup { 284 catch {close $r} 285} -result {qwertyuiop MIDDLE asdfghjkl {}} 286test zlib-8.6 {transformation and fconfigure} -setup { 287 set file [makeFile {} test.z] 288 set fd [open $file wb] 289} -constraints zlib -body { 290 list [fconfigure $fd] [zlib push compress $fd; fconfigure $fd] \ 291 [chan pop $fd; fconfigure $fd] 292} -cleanup { 293 catch {close $fd} 294 removeFile $file 295} -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}} 296test zlib-8.7 {transformation and fconfigure} -setup { 297 set file [makeFile {} test.gz] 298 set fd [open $file wb] 299} -constraints zlib -body { 300 list [fconfigure $fd] [zlib push gzip $fd; fconfigure $fd] \ 301 [chan pop $fd; fconfigure $fd] 302} -cleanup { 303 catch {close $fd} 304 removeFile $file 305} -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}} 306# Input is headers from fetching SPDY draft 307# Dictionary is that which is proposed _in_ SPDY draft 308set 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" 309set 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" 310test zlib-8.8 {transformation and fconfigure} -setup { 311 lassign [chan pipe] inSide outSide 312} -constraints zlib -body { 313 zlib push compress $outSide -dictionary $spdyDict 314 fconfigure $outSide -blocking 1 -translation binary -buffering none 315 fconfigure $inSide -blocking 1 -translation binary 316 puts -nonewline $outSide $spdyHeaders 317 chan pop $outSide 318 chan close $outSide 319 set compressed [read $inSide] 320 catch {zlib decompress $compressed} err opt 321 list [string length [zlib compress $spdyHeaders]] \ 322 [string length $compressed] \ 323 $err [dict get $opt -errorcode] [zlib adler32 $spdyDict] 324} -cleanup { 325 catch {close $outSide} 326 catch {close $inSide} 327} -result {260 222 {need dictionary} {TCL ZLIB NEED_DICT 2381337010} 2381337010} 328test zlib-8.9 {transformation and fconfigure} -setup { 329 lassign [chan pipe] inSide outSide 330 set strm [zlib stream decompress] 331} -constraints zlib -body { 332 zlib push compress $outSide -dictionary $spdyDict 333 fconfigure $outSide -blocking 1 -translation binary -buffering none 334 fconfigure $inSide -blocking 1 -translation binary 335 puts -nonewline $outSide $spdyHeaders 336 set result [fconfigure $outSide -checksum] 337 chan pop $outSide 338 chan close $outSide 339 $strm put -dictionary $spdyDict [read $inSide] 340 lappend result [string length $spdyHeaders] [string length [$strm get]] 341} -cleanup { 342 catch {close $outSide} 343 catch {close $inSide} 344 catch {$strm close} 345} -result {3064818174 358 358} 346test zlib-8.10 {transformation and fconfigure} -setup { 347 lassign [chan pipe] inSide outSide 348} -constraints {zlib recentZlib} -body { 349 zlib push deflate $outSide -dictionary $spdyDict 350 fconfigure $outSide -blocking 1 -translation binary -buffering none 351 fconfigure $inSide -blocking 1 -translation binary 352 puts -nonewline $outSide $spdyHeaders 353 chan pop $outSide 354 chan close $outSide 355 set compressed [read $inSide] 356 catch { 357 zlib inflate $compressed 358 throw UNREACHABLE "should be unreachable" 359 } err opt 360 list [string length [zlib deflate $spdyHeaders]] \ 361 [string length $compressed] \ 362 $err [dict get $opt -errorcode] 363} -cleanup { 364 catch {close $outSide} 365 catch {close $inSide} 366} -result {254 212 {data error} {TCL ZLIB DATA}} 367test zlib-8.11 {transformation and fconfigure} -setup { 368 lassign [chan pipe] inSide outSide 369 set strm [zlib stream inflate] 370} -constraints zlib -body { 371 zlib push deflate $outSide -dictionary $spdyDict 372 fconfigure $outSide -blocking 1 -translation binary -buffering none 373 fconfigure $inSide -blocking 1 -translation binary 374 puts -nonewline $outSide $spdyHeaders 375 chan pop $outSide 376 chan close $outSide 377 $strm put -dictionary $spdyDict [read $inSide] 378 list [string length $spdyHeaders] [string length [$strm get]] 379} -cleanup { 380 catch {close $outSide} 381 catch {close $inSide} 382 catch {$strm close} 383} -result {358 358} 384test zlib-8.12 {transformation and fconfigure} -setup { 385 lassign [chan pipe] inSide outSide 386 set strm [zlib stream compress] 387} -constraints zlib -body { 388 $strm put -dictionary $spdyDict -finalize $spdyHeaders 389 zlib push decompress $inSide 390 fconfigure $outSide -blocking 1 -translation binary 391 fconfigure $inSide -translation binary -dictionary $spdyDict 392 puts -nonewline $outSide [$strm get] 393 close $outSide 394 list [string length $spdyHeaders] [string length [read $inSide]] \ 395 [fconfigure $inSide -checksum] 396} -cleanup { 397 catch {close $outSide} 398 catch {close $inSide} 399 catch {$strm close} 400} -result {358 358 3064818174} 401test zlib-8.13 {transformation and fconfigure} -setup { 402 lassign [chan pipe] inSide outSide 403 set strm [zlib stream compress] 404} -constraints zlib -body { 405 $strm put -dictionary $spdyDict -finalize $spdyHeaders 406 zlib push decompress $inSide -dictionary $spdyDict 407 fconfigure $outSide -blocking 1 -translation binary 408 fconfigure $inSide -translation binary 409 puts -nonewline $outSide [$strm get] 410 close $outSide 411 list [string length $spdyHeaders] [string length [read $inSide]] \ 412 [fconfigure $inSide -checksum] 413} -cleanup { 414 catch {close $outSide} 415 catch {close $inSide} 416 catch {$strm close} 417} -result {358 358 3064818174} 418test zlib-8.14 {transformation and fconfigure} -setup { 419 lassign [chan pipe] inSide outSide 420 set strm [zlib stream deflate] 421} -constraints zlib -body { 422 $strm put -finalize -dictionary $spdyDict $spdyHeaders 423 zlib push inflate $inSide 424 fconfigure $outSide -blocking 1 -buffering none -translation binary 425 fconfigure $inSide -translation binary -dictionary $spdyDict 426 puts -nonewline $outSide [$strm get] 427 close $outSide 428 list [string length $spdyHeaders] [string length [read $inSide]] 429} -cleanup { 430 catch {close $outSide} 431 catch {close $inSide} 432 catch {$strm close} 433} -result {358 358} 434test zlib-8.15 {transformation and fconfigure} -setup { 435 lassign [chan pipe] inSide outSide 436 set strm [zlib stream deflate] 437} -constraints zlib -body { 438 $strm put -finalize -dictionary $spdyDict $spdyHeaders 439 zlib push inflate $inSide -dictionary $spdyDict 440 fconfigure $outSide -blocking 1 -buffering none -translation binary 441 fconfigure $inSide -translation binary 442 puts -nonewline $outSide [$strm get] 443 close $outSide 444 list [string length $spdyHeaders] [string length [read $inSide]] 445} -cleanup { 446 catch {close $outSide} 447 catch {close $inSide} 448 catch {$strm close} 449} -result {358 358} 450test zlib-8.16 {Bug 3603553: buffer transfer with large writes} -setup { 451 # Actual data isn't very important; needs to be substantially larger than 452 # the internal buffer (32kB) and incompressible. 453 set largeData {} 454 for {set i 0;expr {srand(1)}} {$i < 100000} {incr i} { 455 append largeData [lindex "a b c d e f g h i j k l m n o p" \ 456 [expr {int(16*rand())}]] 457 } 458 set file [makeFile {} test.gz] 459} -constraints zlib -body { 460 set f [open $file wb] 461 fconfigure $f -buffering none 462 zlib push gzip $f 463 puts -nonewline $f $largeData 464 close $f 465 file size $file 466} -cleanup { 467 removeFile $file 468} -result 57647 469test zlib-8.17 {Bug dd260aaf: fconfigure} -setup { 470 lassign [chan pipe] inSide outSide 471} -constraints zlib -body { 472 zlib push inflate $inSide 473 zlib push deflate $outSide 474 list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary] 475} -cleanup { 476 catch {close $inSide} 477 catch {close $outSide} 478} -result {{} {}} 479test zlib-8.18 {Bug dd260aaf: fconfigure} -setup { 480 lassign [chan pipe] inSide outSide 481} -constraints zlib -body { 482 zlib push inflate $inSide -dictionary "one two" 483 zlib push deflate $outSide -dictionary "one two" 484 list [chan configure $inSide -dictionary] [chan configure $outSide -dictionary] 485} -cleanup { 486 catch {close $inSide} 487 catch {close $outSide} 488} -result {{one two} {one two}} 489 490test zlib-9.1 "check fcopy with push" -constraints zlib -setup { 491 set sfile [makeFile {} testsrc.gz] 492 set file [makeFile {} test.gz] 493 set f [open $sfile wb] 494 puts -nonewline $f [zlib gzip [string repeat a 81920]] 495 close $f 496} -body { 497 set fin [zlib push gunzip [open $sfile rb]] 498 set fout [open $file wb] 499 set total [fcopy $fin $fout] 500 close $fin ; close $fout 501 list copied $total size [file size $file] 502} -cleanup { 503 removeFile $file 504 removeFile $sfile 505} -result {copied 81920 size 81920} 506test zlib-9.2 "socket fcopy with push" -constraints zlib -setup { 507 set srv [socket -myaddr localhost -server {apply {{c a p} { 508 chan configure $c -translation binary -buffering none -blocking 0 509 puts -nonewline $c [zlib gzip [string repeat a 81920]] 510 close $c 511 set ::total -1 512 }}} 0] 513 set file [makeFile {} test.gz] 514} -body { 515 lassign [chan configure $srv -sockname] addr name port 516 set sin [socket $addr $port] 517 chan configure $sin -translation binary 518 zlib push gunzip $sin 519 after 1000 {set ::total timeout} 520 vwait ::total 521 after cancel {set ::total timeout} 522 if {$::total != -1} {error "unexpected value $::total of ::total"} 523 set total [fcopy $sin [set fout [open $file wb]]] 524 close $sin 525 close $fout 526 list read $total size [file size $file] 527} -cleanup { 528 close $srv 529 removeFile $file 530} -result {read 81920 size 81920} 531test zlib-9.3 "socket fcopy bg (identity)" -constraints {tempNotWin zlib} -setup { 532 set srv [socket -myaddr localhost -server {apply {{c a p} { 533 #puts "connection from $a:$p on $c" 534 chan configure $c -translation binary -buffering none -blocking 0 535 puts -nonewline $c [string repeat a 81920] 536 close $c 537 }}} 0] 538 set file [makeFile {} test.gz] 539} -body { 540 lassign [chan configure $srv -sockname] addr name port 541 #puts "listening for connections on $addr $port" 542 set sin [socket localhost $port] 543 chan configure $sin -translation binary 544 update 545 set fout [open $file wb] 546 after 1000 {set ::total timeout} 547 fcopy $sin $fout -command {apply {{c {e {}}} { 548 set ::total [expr {$e eq {} ? $c : $e}] 549 }}} 550 vwait ::total 551 after cancel {set ::total timeout} 552 close $sin; close $fout 553 list read $::total size [file size $file] 554} -cleanup { 555 close $srv 556 removeFile $file 557} -returnCodes {ok error} -result {read 81920 size 81920} 558test zlib-9.4 "socket fcopy bg (gzip)" -constraints zlib -setup { 559 set srv [socket -myaddr localhost -server {apply {{c a p} { 560 chan configure $c -translation binary -buffering none -blocking 0 561 puts -nonewline $c [zlib gzip [string repeat a 81920]] 562 close $c 563 }}} 0] 564 set file [makeFile {} test.gz] 565} -body { 566 lassign [chan configure $srv -sockname] addr name port 567 set sin [socket $addr $port] 568 chan configure $sin -translation binary 569 zlib push gunzip $sin 570 update 571 set fout [open $file wb] 572 after 1000 {set ::total timeout} 573 fcopy $sin $fout -command {apply {{c {e {}}} { 574 set ::total [expr {$e eq {} ? $c : $e}] 575 }}} 576 vwait ::total 577 after cancel {set ::total timeout} 578 close $sin; close $fout 579 list read $::total size [file size $file] 580} -cleanup { 581 close $srv 582 removeFile $file 583} -result {read 81920 size 81920} 584test zlib-9.5 "socket fcopy incremental (gzip)" -constraints zlib -setup { 585 set srv [socket -myaddr localhost -server {apply {{c a p} { 586 chan configure $c -translation binary -buffering none -blocking 0 587 puts -nonewline $c [zlib gzip [string repeat a 81920]] 588 close $c 589 }}} 0] 590 proc zlib95copy {i o t c {e {}}} { 591 incr t $c 592 if {$e ne {}} { 593 set ::total [list error $e] 594 } elseif {[eof $i]} { 595 set ::total [list eof $t] 596 } else { 597 fcopy $i $o -size 8192 -command [list zlib95copy $i $o $t] 598 } 599 } 600 set file [makeFile {} test.gz] 601} -body { 602 lassign [chan configure $srv -sockname] addr name port 603 set sin [socket $addr $port] 604 chan configure $sin -translation binary 605 zlib push gunzip $sin 606 update 607 set fout [open $file wb] 608 after 1000 {set ::total timeout} 609 fcopy $sin $fout -size 8192 -command [list zlib95copy $sin $fout 0] 610 vwait ::total 611 after cancel {set ::total timeout} 612 close $sin; close $fout 613 list $::total size [file size $file] 614} -cleanup { 615 close $srv 616 rename zlib95copy {} 617 removeFile $file 618} -result {{eof 81920} size 81920} 619test zlib-9.6 "bug #2818131 (gzip)" -constraints zlib -setup { 620 set srv [socket -myaddr localhost -server {apply {{c a p} { 621 chan configure $c -translation binary -buffering none -blocking 0 622 zlib push gzip $c 623 puts -nonewline $c [string repeat hello 100] 624 close $c 625 }}} 0] 626} -body { 627 lassign [chan configure $srv -sockname] addr name port 628 after 1000 {set ::total timeout} 629 set s [socket $addr $port] 630 chan configure $s -translation binary 631 zlib push gunzip $s 632 chan event $s readable [list apply {{s} { 633 set d [read $s] 634 if {[eof $s]} { 635 chan event $s readable {} 636 set ::total [list eof [string length $d]] 637 } 638 }} $s] 639 vwait ::total 640 after cancel {set ::total timeout} 641 close $s 642 set ::total 643} -cleanup { 644 close $srv 645 unset -nocomplain total 646} -result {eof 500} 647test zlib-9.7 "bug #2818131 (compress)" -constraints zlib -setup { 648 set srv [socket -myaddr localhost -server {apply {{c a p} { 649 chan configure $c -translation binary -buffering none -blocking 0 650 zlib push compress $c 651 puts -nonewline $c [string repeat hello 100] 652 close $c 653 }}} 0] 654} -body { 655 lassign [chan configure $srv -sockname] addr name port 656 after 1000 {set ::total timeout} 657 set s [socket $addr $port] 658 chan configure $s -translation binary 659 zlib push decompress $s 660 chan event $s readable [list apply {{s} { 661 set d [read $s] 662 if {[eof $s]} { 663 chan event $s readable {} 664 set ::total [list eof [string length $d]] 665 } 666 }} $s] 667 vwait ::total 668 after cancel {set ::total timeout} 669 close $s 670 set ::total 671} -cleanup { 672 close $srv 673 unset -nocomplain total 674} -result {eof 500} 675test zlib-9.8 "bug #2818131 (deflate)" -constraints zlib -setup { 676 set srv [socket -myaddr localhost -server {apply {{c a p} { 677 chan configure $c -translation binary -buffering none -blocking 0 678 zlib push deflate $c 679 puts -nonewline $c [string repeat hello 100] 680 close $c 681 }}} 0] 682} -body { 683 lassign [chan configure $srv -sockname] addr name port 684 after 1000 {set ::total timeout} 685 set s [socket $addr $port] 686 chan configure $s -translation binary 687 zlib push inflate $s 688 chan event $s readable [list apply {{s} { 689 set d [read $s] 690 if {[eof $s]} { 691 chan event $s readable {} 692 set ::total [list eof [string length $d]] 693 } 694 }} $s] 695 vwait ::total 696 after cancel {set ::total timeout} 697 close $s 698 set ::total 699} -cleanup { 700 unset -nocomplain total 701 close $srv 702} -result {eof 500} 703test zlib-9.9 "bug #2818131 (gzip mismatch)" -constraints zlib -setup { 704 proc bgerror {s} {set ::total [list error $s]} 705 set srv [socket -myaddr localhost -server {apply {{c a p} { 706 chan configure $c -translation binary -buffering none -blocking 0 707 zlib push gzip $c 708 puts -nonewline $c [string repeat hello 100] 709 close $c 710 }}} 0] 711} -body { 712 lassign [chan configure $srv -sockname] addr name port 713 after 1000 {set ::total timeout} 714 set s [socket $addr $port] 715 try { 716 chan configure $s -translation binary 717 zlib push inflate $s 718 chan event $s readable [list apply {{s} { 719 set d [read $s] 720 if {[eof $s]} { 721 chan event $s readable {} 722 set ::total [list eof [string length $d]] 723 } 724 }} $s] 725 vwait ::total 726 } finally { 727 after cancel {set ::total timeout} 728 close $s 729 } 730 set ::total 731} -cleanup { 732 unset -nocomplain total 733 close $srv 734 rename bgerror {} 735} -result {error {invalid block type}} 736test zlib-9.10 "bug #2818131 (compress mismatch)" -constraints zlib -setup { 737 proc bgerror {s} {set ::total [list error $s]} 738 set srv [socket -myaddr localhost -server {apply {{c a p} { 739 chan configure $c -translation binary -buffering none -blocking 0 740 zlib push compress $c 741 puts -nonewline $c [string repeat hello 100] 742 close $c 743 }}} 0] 744} -body { 745 lassign [chan configure $srv -sockname] addr name port 746 after 1000 {set ::total timeout} 747 set s [socket $addr $port] 748 try { 749 chan configure $s -translation binary 750 zlib push inflate $s 751 chan event $s readable [list apply {{s} { 752 set d [read $s] 753 if {[eof $s]} { 754 chan event $s readable {} 755 set ::total [list eof [string length $d]] 756 } 757 }} $s] 758 vwait ::total 759 } finally { 760 after cancel {set ::total timeout} 761 close $s 762 } 763 set ::total 764} -cleanup { 765 unset -nocomplain total 766 close $srv 767 rename bgerror {} 768} -result {error {invalid stored block lengths}} 769test zlib-9.11 "bug #2818131 (deflate mismatch)" -constraints zlib -setup { 770 proc bgerror {s} {set ::total [list error $s]} 771 set srv [socket -myaddr localhost -server {apply {{c a p} { 772 chan configure $c -translation binary -buffering none -blocking 0 773 zlib push deflate $c 774 puts -nonewline $c [string repeat hello 100] 775 close $c 776 }}} 0] 777} -body { 778 lassign [chan configure $srv -sockname] addr name port 779 after 1000 {set ::total timeout} 780 set s [socket $addr $port] 781 try { 782 chan configure $s -translation binary 783 zlib push gunzip $s 784 chan event $s readable [list apply {{s} { 785 set d [read $s] 786 if {[eof $s]} { 787 chan event $s readable {} 788 set ::total [list eof [string length $d]] 789 } 790 }} $s] 791 vwait ::total 792 } finally { 793 after cancel {set ::total timeout} 794 close $s 795 } 796 set ::total 797} -cleanup { 798 unset -nocomplain total 799 close $srv 800 rename bgerror {} 801} -result {error {incorrect header check}} 802 803test zlib-10.0 "bug #2818131 (close with null interp)" -constraints { 804 zlib 805} -setup { 806 proc bgerror {s} {set ::total [list error $s]} 807 set srv [socket -myaddr localhost -server {apply {{c a p} { 808 chan configure $c -translation binary 809 zlib push inflate $c 810 chan event $c readable [list apply {{c} { 811 set d [read $c] 812 if {[eof $c]} { 813 chan event $c readable {} 814 close $c 815 set ::total [list eof [string length $d]] 816 } 817 }} $c] 818 }}} 0] 819} -body { 820 lassign [chan configure $srv -sockname] addr name port 821 after 1000 {set ::total timeout} 822 set s [socket $addr $port] 823 chan configure $s -translation binary -buffering none -blocking 0 824 zlib push gzip $s 825 chan event $s xyzzy [list apply {{s} { 826 if {[gets $s line] < 0} { 827 chan close $s 828 } 829 }} $s] 830 after idle [list apply {{s} { 831 puts $s test 832 chan close $s 833 after 100 {set ::total done} 834 }} $s] 835 vwait ::total 836 after cancel {set ::total timeout} 837 after cancel {set ::total done} 838 set ::total 839} -cleanup { 840 close $srv 841 rename bgerror {} 842} -returnCodes error \ 843 -result {bad event name "xyzzy": must be readable or writable} 844test zlib-10.1 "bug #2818131 (mismatch read)" -constraints { 845 zlib 846} -setup { 847 proc bgerror {s} {set ::total [list error $s]} 848 proc zlibRead {c} { 849 set d [read $c] 850 if {[eof $c]} { 851 chan event $c readable {} 852 close $c 853 set ::total [list eof [string length $d]] 854 } 855 } 856 set srv [socket -myaddr localhost -server {apply {{c a p} { 857 chan configure $c -translation binary 858 zlib push inflate $c 859 chan event $c readable [list zlibRead $c] 860 }}} 0] 861} -body { 862 lassign [chan configure $srv -sockname] addr name port 863 after 1000 {set ::total timeout} 864 set s [socket $addr $port] 865 chan configure $s -translation binary -buffering none -blocking 0 866 zlib push gzip $s 867 chan event $s readable [list zlibRead $s] 868 after idle [list apply {{s} { 869 puts $s test 870 chan close $s 871 after 100 {set ::total done} 872 }} $s] 873 vwait ::total 874 after cancel {set ::total timeout} 875 after cancel {set ::total done} 876 set ::total 877} -cleanup { 878 close $srv 879 rename bgerror {} 880 rename zlibRead {} 881} -result {error {invalid block type}} 882test zlib-10.2 "bug #2818131 (mismatch gets)" -constraints { 883 zlib 884} -setup { 885 proc bgerror {s} {set ::total [list error $s]} 886 proc zlibRead {c} { 887 if {[gets $c line] < 0} { 888 close $c 889 set ::total [list error -1] 890 } elseif {[eof $c]} { 891 chan event $c readable {} 892 close $c 893 set ::total [list eof 0] 894 } 895 } 896 set srv [socket -myaddr localhost -server {apply {{c a p} { 897 chan configure $c -translation binary 898 zlib push inflate $c 899 chan event $c readable [list zlibRead $c] 900 }}} 0] 901} -body { 902 lassign [chan configure $srv -sockname] addr name port 903 after 1000 {set ::total timeout} 904 set s [socket $addr $port] 905 chan configure $s -translation binary -buffering none -blocking 0 906 zlib push gzip $s 907 chan event $s readable [list zlibRead $s] 908 after idle [list apply {{s} { 909 puts $s test 910 chan close $s 911 after 100 {set ::total done} 912 }} $s] 913 vwait ::total 914 after cancel {set ::total timeout} 915 after cancel {set ::total done} 916 set ::total 917} -cleanup { 918 close $srv 919 rename bgerror {} 920 rename zlibRead {} 921} -result {error {invalid block type}} 922 923test zlib-11.1 "Bug #3390073: mis-applied gzip filtering" -setup { 924 set file [makeFile {} test.input] 925} -constraints zlib -body { 926 set f [open $file wb] 927 puts -nonewline [zlib push gzip $f] [string repeat "hello" 1000] 928 close $f 929 set f [open $file rb] 930 set d [read $f] 931 close $f 932 set d [zlib gunzip $d] 933 list [regexp -all "hello" $d] [string length [regsub -all "hello" $d {}]] 934} -cleanup { 935 removeFile $file 936} -result {1000 0} 937test zlib-11.2 "Bug #3390073: mis-applied gzip filtering" -setup { 938 set file [makeFile {} test.input] 939} -constraints zlib -body { 940 set f [open $file wb] 941 puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \ 942 [string repeat "hello" 1000] 943 close $f 944 set f [open $file rb] 945 set d [read $f] 946 close $f 947 set d [zlib gunzip $d -header h] 948 list [regexp -all "hello" $d] [dict get $h filename] \ 949 [string length [regsub -all "hello" $d {}]] 950} -cleanup { 951 removeFile $file 952} -result {1000 /foo/bar 0} 953test zlib-11.3 {Bug 3595576 variant} -setup { 954 set file [makeFile {} test.input] 955} -constraints zlib -body { 956 set f [open $file wb] 957 puts -nonewline [zlib push gzip $f -header {filename /foo/bar}] \ 958 [string repeat "hello" 1000] 959 close $f 960 set f [open $file rb] 961 set d [read $f] 962 close $f 963 zlib gunzip $d -header noSuchNs::foo 964} -cleanup { 965 removeFile $file 966} -returnCodes error -result {can't set "noSuchNs::foo": parent namespace doesn't exist} 967 968test zlib-12.1 {Tk Bug 9eb55debc5} -constraints zlib -setup { 969 set stream [zlib stream compress] 970} -body { 971 for {set opts {};set y 0} {$y < 60} {incr y} { 972 for {set line {};set x 0} {$x < 100} {incr x} { 973 append line [binary format ccc $x $y 128] 974 } 975 if {$y == 59} { 976 set opts -finalize 977 } 978 $stream put {*}$opts $line 979 } 980 set data [$stream get] 981 list [string length $data] [string length [zlib decompress $data]] 982} -cleanup { 983 $stream close 984} -result {12026 18000} 985test zlib-12.2 {Patrick Dunnigan's issue} -constraints zlib -setup { 986 set filesrc [makeFile {} test.input] 987 set filedst [makeFile {} test.output] 988 set f [open $filesrc "wb"] 989 for {set i 0} {$i < 10000} {incr i} { 990 puts -nonewline $f "x" 991 } 992 close $f 993} -body { 994 set fin [open $filesrc "rb"] 995 set fout [open $filedst "wb"] 996 set header [dict create filename "test.input" time 0] 997 try { 998 fcopy $fin [zlib push gzip $fout -header $header] 999 } finally { 1000 close $fin 1001 close $fout 1002 } 1003 file size $filedst 1004} -cleanup { 1005 removeFile $filesrc 1006 removeFile $filedst 1007} -result 56 1008 1009set zlibbinf "" 1010proc _zlibbinf {} { 1011 # inlined zlib.bin file creator: 1012 variable zlibbinf 1013 if {$zlibbinf eq ""} { 1014 set zlibbinf [makeFile {} test-zlib-13.bin] 1015 set f [open $zlibbinf wb] 1016 puts -nonewline $f [zlib decompress [binary decode base64 { 1017 eJx7e+6s1+EAgYaLjK3ratptGmOck0vT/y/ZujHAd0qJelDBXfUPJ3tfrtLbpX+wOOFHmtn03/tizm 1018 /+tXROXU3d203b79p5X6/0cvUyFzTsqOj4sa9r8SrZI5zT7265e2Xzq595Fb9LbpgffVy7cZaJ/d15 1019 4U9L7LLM2vdqut8+aSU/r6q9Ltv6+T9mBhTgIK97bH33m/O1C1eBwf9FDKNgaIDaj9wA+5hToA== 1020 }]] 1021 close $f 1022 } 1023 return $zlibbinf 1024} 1025test zlib-13.1 {Ticket [8af92dfb66] - zlib stream mis-expansion} -constraints zlib -setup { 1026 set pathin [_zlibbinf] 1027 set chanin [open $pathin rb] 1028 set pathout [makeFile {} test-zlib-13.deflated] 1029 set chanout [open $pathout wb] 1030 zlib push inflate $chanin 1031 fcopy $chanin $chanout 1032 close $chanin 1033 close $chanout 1034} -body { 1035 file size $pathout 1036} -cleanup { 1037 removeFile $pathout 1038 unset chanin pathin chanout pathout 1039} -result 458752 1040 1041test zlib-13.2 {Ticket [f70ce1fead] - zlib multi-stream expansion} -constraints zlib -setup { 1042 # Start from the basic asset 1043 set pathin [_zlibbinf] 1044 set chanin [open $pathin rb] 1045 # Create a multi-stream by copying the asset twice into it. 1046 set pathout [makeFile {} test-zlib-13.multi] 1047 set chanout [open $pathout wb] 1048 fcopy $chanin $chanout 1049 seek $chanin 0 start 1050 fcopy $chanin $chanout 1051 close $chanin 1052 close $chanout 1053 # The multi-stream file shall be our input 1054 set pathin $pathout 1055 set chanin [open $pathin rb] 1056 # And our destinations 1057 set pathout1 [makeFile {} test-zlib-13.multi-1] 1058 set pathout2 [makeFile {} test-zlib-13.multi-2] 1059} -body { 1060 # Decode first stream 1061 set chanout [open $pathout1 wb] 1062 zlib push inflate $chanin 1063 fcopy $chanin $chanout 1064 chan pop $chanin 1065 close $chanout 1066 # Decode second stream 1067 set chanout [open $pathout2 wb] 1068 zlib push inflate $chanin 1069 fcopy $chanin $chanout 1070 chan pop $chanin 1071 close $chanout 1072 # 1073 list [file size $pathout1] [file size $pathout2] 1074} -cleanup { 1075 close $chanin 1076 removeFile $pathout 1077 removeFile $pathout1 1078 removeFile $pathout2 1079 unset chanin pathin chanout pathout pathout1 pathout2 1080} -result {458752 458752} 1081 1082if {$zlibbinf ne ""} { 1083 removeFile $zlibbinf 1084} 1085unset zlibbinf 1086rename _zlibbinf {} 1087 1088 1089::tcltest::cleanupTests 1090return 1091 1092# Local Variables: 1093# mode: tcl 1094# End: 1095