ext/Compress/Zlib/t/02zlib.t

   1
   2
   3 use strict ;
   4 use warnings ;
   5
   6 use Compress::Zlib ;
   7
   8 sub ok
   9 {
  10     my ($no, $ok) = @_ ;
  11
  12     #++ $total ;
  13     #++ $totalBad unless $ok ;
  14
  15     print "ok $no\n" if $ok ;
  16     print "not ok $no\n" unless $ok ;
  17 }
  18
  19 sub readFile
  20 {
  21     my ($filename) = @_ ;
  22     my ($string) = '' ;
  23
  24     open (F, "<$filename")
  25         or die "Cannot open $filename: $!\n" ;
  26     binmode(F);
  27     while (<F>)
  28       { $string .= $_ }
  29     close F ;
  30     $string ;
  31 }
  32
  33 my $hello = <<EOM ;
  34 hello world
  35 this is a test
  36 EOM
  37
  38 my $len   = length $hello ;
  39
  40
  41 print "1..239\n" ;
  42
  43 # Check zlib_version and ZLIB_VERSION are the same.
  44 ok(1, Compress::Zlib::zlib_version eq ZLIB_VERSION) ;
  45
  46 # gzip tests
  47 #===========
  48
  49 my $name = "test.gz" ;
  50 my ($x, $uncomp) ;
  51
  52 ok(2, my $fil = gzopen($name, "wb")) ;
  53
  54 ok(3, $gzerrno == 0);
  55
  56 ok(4, $fil->gzwrite($hello) == $len) ;
  57
  58 ok(5, ! $fil->gzclose ) ;
  59
  60 ok(6, $fil = gzopen($name, "rb") ) ;
  61
  62 ok(7, $gzerrno == 0);
  63
  64 ok(8, ($x = $fil->gzread($uncomp)) == $len) ;
  65
  66 ok(9, ! $fil->gzclose ) ;
  67
  68 unlink $name ;
  69
  70 ok(10, $hello eq $uncomp) ;
  71
  72 # check that a number can be gzipped
  73 my $number = 7603 ;
  74 my $num_len = 4 ;
  75
  76 ok(11, $fil = gzopen($name, "wb")) ;
  77
  78 ok(12, $gzerrno == 0);
  79
  80 ok(13, $fil->gzwrite($number) == $num_len) ;
  81
  82 ok(14, $gzerrno == 0);
  83
  84 ok(15, ! $fil->gzclose ) ;
  85
  86 ok(16, $gzerrno == 0);
  87
  88 ok(17, $fil = gzopen($name, "rb") ) ;
  89
  90 ok(18, ($x = $fil->gzread($uncomp)) == $num_len) ;
  91
  92 ok(19, $gzerrno == 0 || $gzerrno == Z_STREAM_END);
  93
  94 ok(20, ! $fil->gzclose ) ;
  95
  96 ok(21, $gzerrno == 0);
  97
  98 unlink $name ;
  99
 100 ok(22, $number == $uncomp) ;
 101 ok(23, $number eq $uncomp) ;
 102
 103
 104 # now a bigger gzip test
 105
 106 my $text = 'text' ;
 107 my $file = "$text.gz" ;
 108
 109 ok(24, my $f = gzopen($file, "wb")) ;
 110
 111 # generate a long random string
 112 my $contents = '' ;
 113 foreach (1 .. 5000)
 114   { $contents .= chr int rand 256 }
 115
 116 $len = length $contents ;
 117
 118 ok(25, $f->gzwrite($contents) == $len ) ;
 119
 120 ok(26, ! $f->gzclose );
 121
 122 ok(27, $f = gzopen($file, "rb")) ;
 123
 124 my $uncompressed ;
 125 ok(28, $f->gzread($uncompressed, $len) == $len) ;
 126
 127 ok(29, $contents eq $uncompressed) ;
 128
 129 ok(30, ! $f->gzclose ) ;
 130
 131 unlink($file) ;
 132
 133 # gzip - readline tests
 134 # ======================
 135
 136 # first create a small gzipped text file
 137 $name = "test.gz" ;
 138 my @text = (<<EOM, <<EOM, <<EOM, <<EOM) ;
 139 this is line 1
 140 EOM
 141 the second line
 142 EOM
 143 the line after the previous line
 144 EOM
 145 the final line
 146 EOM
 147
 148 $text = join("", @text) ;
 149
 150 ok(31, $fil = gzopen($name, "wb")) ;
 151 ok(32, $fil->gzwrite($text) == length $text) ;
 152 ok(33, ! $fil->gzclose ) ;
 153
 154 # now try to read it back in
 155 ok(34, $fil = gzopen($name, "rb")) ;
 156 my $aok = 1 ;
 157 my $remember = '';
 158 my $line = '';
 159 my $lines = 0 ;
 160 while ($fil->gzreadline($line) > 0) {
 161     ($aok = 0), last
 162         if $line ne $text[$lines] ;
 163     $remember .= $line ;
 164     ++ $lines ;
 165 }
 166 ok(35, $aok) ;
 167 ok(36, $remember eq $text) ;
 168 ok(37, $lines == @text) ;
 169 ok(38, ! $fil->gzclose ) ;
 170 unlink($name) ;
 171
 172 # a text file with a very long line (bigger than the internal buffer)
 173 my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ;
 174 my $line2 = "second line\n" ;
 175 $text = $line1 . $line2 ;
 176 ok(39, $fil = gzopen($name, "wb")) ;
 177 ok(40, $fil->gzwrite($text) == length $text) ;
 178 ok(41, ! $fil->gzclose ) ;
 179
 180 # now try to read it back in
 181 ok(42, $fil = gzopen($name, "rb")) ;
 182 my $i = 0 ;
 183 my @got = ();
 184 while ($fil->gzreadline($line) > 0) {
 185     $got[$i] = $line ;
 186     ++ $i ;
 187 }
 188 ok(43, $i == 2) ;
 189 ok(44, $got[0] eq $line1 ) ;
 190 ok(45, $got[1] eq $line2) ;
 191
 192 ok(46, ! $fil->gzclose ) ;
 193
 194 unlink $name ;
 195
 196 # a text file which is not termined by an EOL
 197
 198 $line1 = "hello hello, I'm back again\n" ;
 199 $line2 = "there is no end in sight" ;
 200
 201 $text = $line1 . $line2 ;
 202 ok(47, $fil = gzopen($name, "wb")) ;
 203 ok(48, $fil->gzwrite($text) == length $text) ;
 204 ok(49, ! $fil->gzclose ) ;
 205
 206 # now try to read it back in
 207 ok(50, $fil = gzopen($name, "rb")) ;
 208 @got = () ; $i = 0 ;
 209 while ($fil->gzreadline($line) > 0) {
 210     $got[$i] = $line ;
 211     ++ $i ;
 212 }
 213 ok(51, $i == 2) ;
 214 ok(52, $got[0] eq $line1 ) ;
 215 ok(53, $got[1] eq $line2) ;
 216
 217 ok(54, ! $fil->gzclose ) ;
 218
 219 unlink $name ;
 220
 221
 222 # mix gzread and gzreadline <
 223
 224 # case 1: read a line, then a block. The block is
 225 #         smaller than the internal block used by
 226 #         gzreadline
 227 $line1 = "hello hello, I'm back again\n" ;
 228 $line2 = "abc" x 200 ;
 229 my $line3 = "def" x 200 ;
 230
 231 $text = $line1 . $line2 . $line3 ;
 232 ok(55, $fil = gzopen($name, "wb")) ;
 233 ok(56, $fil->gzwrite($text) == length $text) ;
 234 ok(57, ! $fil->gzclose ) ;
 235
 236 # now try to read it back in
 237 ok(58, $fil = gzopen($name, "rb")) ;
 238 ok(59, $fil->gzreadline($line) > 0) ;
 239 ok(60, $line eq $line1) ;
 240 ok(61, $fil->gzread($line, length $line2) > 0) ;
 241 ok(62, $line eq $line2) ;
 242 ok(63, $fil->gzread($line, length $line3) > 0) ;
 243 ok(64, $line eq $line3) ;
 244 ok(65, ! $fil->gzclose ) ;
 245 unlink $name ;
 246
 247 # change $/ <<TODO
 248
 249
 250
 251 # compress/uncompress tests
 252 # =========================
 253
 254 $hello = "hello mum" ;
 255 my $keep_hello = $hello ;
 256
 257 my $compr = compress($hello) ;
 258 ok(66, $compr ne "") ;
 259
 260 my $keep_compr = $compr ;
 261
 262 my $uncompr = uncompress ($compr) ;
 263
 264 ok(67, $hello eq $uncompr) ;
 265
 266 ok(68, $hello eq $keep_hello) ;
 267 ok(69, $compr eq $keep_compr) ;
 268
 269 # compress a number
 270 $hello = 7890 ;
 271 $keep_hello = $hello ;
 272
 273 $compr = compress($hello) ;
 274 ok(70, $compr ne "") ;
 275
 276 $keep_compr = $compr ;
 277
 278 $uncompr = uncompress ($compr) ;
 279
 280 ok(71, $hello eq $uncompr) ;
 281
 282 ok(72, $hello eq $keep_hello) ;
 283 ok(73, $compr eq $keep_compr) ;
 284
 285 # bigger compress
 286
 287 $compr = compress ($contents) ;
 288 ok(74, $compr ne "") ;
 289
 290 $uncompr = uncompress ($compr) ;
 291
 292 ok(75, $contents eq $uncompr) ;
 293
 294 # buffer reference
 295
 296 $compr = compress(\$hello) ;
 297 ok(76, $compr ne "") ;
 298
 299
 300 $uncompr = uncompress (\$compr) ;
 301 ok(77, $hello eq $uncompr) ;
 302
 303 # bad level
 304 $compr = compress($hello, 1000) ;
 305 ok(78, ! defined $compr);
 306
 307 # change level
 308 $compr = compress($hello, Z_BEST_COMPRESSION) ;
 309 ok(79, defined $compr);
 310 $uncompr = uncompress (\$compr) ;
 311 ok(80, $hello eq $uncompr) ;
 312
 313 # deflate/inflate - small buffer
 314 # ==============================
 315
 316 $hello = "I am a HAL 9000 computer" ;
 317 my @hello = split('', $hello) ;
 318 my ($err, $X, $status);
 319
 320 ok(81,  ($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
 321 ok(82, $x) ;
 322 ok(83, $err == Z_OK) ;
 323
 324 my $Answer = '';
 325 foreach (@hello)
 326 {
 327     ($X, $status) = $x->deflate($_) ;
 328     last unless $status == Z_OK ;
 329
 330     $Answer .= $X ;
 331 }
 332
 333 ok(84, $status == Z_OK) ;
 334
 335 ok(85,    (($X, $status) = $x->flush())[1] == Z_OK ) ;
 336 $Answer .= $X ;
 337
 338
 339 my @Answer = split('', $Answer) ;
 340
 341 my $k;
 342 ok(86, ($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
 343 ok(87, $k) ;
 344 ok(88, $err == Z_OK) ;
 345
 346 my $GOT = '';
 347 my $Z;
 348 foreach (@Answer)
 349 {
 350     ($Z, $status) = $k->inflate($_) ;
 351     $GOT .= $Z ;
 352     last if $status == Z_STREAM_END or $status != Z_OK ;
 353
 354 }
 355
 356 ok(89, $status == Z_STREAM_END) ;
 357 ok(90, $GOT eq $hello ) ;
 358
 359
 360 # deflate/inflate - small buffer with a number
 361 # ==============================
 362
 363 $hello = 6529 ;
 364
 365 ok(91,  ($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
 366 ok(92, $x) ;
 367 ok(93, $err == Z_OK) ;
 368
 369 $Answer = '';
 370 {
 371     ($X, $status) = $x->deflate($hello) ;
 372
 373     $Answer .= $X ;
 374 }
 375
 376 ok(94, $status == Z_OK) ;
 377
 378 ok(95,    (($X, $status) = $x->flush())[1] == Z_OK ) ;
 379 $Answer .= $X ;
 380
 381
 382 @Answer = split('', $Answer) ;
 383
 384 ok(96, ($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
 385 ok(97, $k) ;
 386 ok(98, $err == Z_OK) ;
 387
 388 $GOT = '';
 389 foreach (@Answer)
 390 {
 391     ($Z, $status) = $k->inflate($_) ;
 392     $GOT .= $Z ;
 393     last if $status == Z_STREAM_END or $status != Z_OK ;
 394
 395 }
 396
 397 ok(99, $status == Z_STREAM_END) ;
 398 ok(100, $GOT eq $hello ) ;
 399
 400
 401
 402 # deflate/inflate - larger buffer
 403 # ==============================
 404
 405
 406 ok(101, $x = deflateInit() ) ;
 407
 408 ok(102, (($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
 409
 410 my $Y = $X ;
 411
 412
 413 ok(103, (($X, $status) = $x->flush() )[1] == Z_OK ) ;
 414 $Y .= $X ;
 415
 416
 417
 418 ok(104, $k = inflateInit() ) ;
 419
 420 ($Z, $status) = $k->inflate($Y) ;
 421
 422 ok(105, $status == Z_STREAM_END) ;
 423 ok(106, $contents eq $Z ) ;
 424
 425 # deflate/inflate - preset dictionary
 426 # ===================================
 427
 428 my $dictionary = "hello" ;
 429 ok(107, $x = deflateInit({-Level => Z_BEST_COMPRESSION,
 430                          -Dictionary => $dictionary})) ;
 431
 432 my $dictID = $x->dict_adler() ;
 433
 434 ($X, $status) = $x->deflate($hello) ;
 435 ok(108, $status == Z_OK) ;
 436 ($Y, $status) = $x->flush() ;
 437 ok(109, $status == Z_OK) ;
 438 $X .= $Y ;
 439 $x = 0 ;
 440
 441 ok(110, $k = inflateInit(-Dictionary => $dictionary) ) ;
 442
 443 ($Z, $status) = $k->inflate($X);
 444 ok(111, $status == Z_STREAM_END) ;
 445 ok(112, $k->dict_adler() == $dictID);
 446 ok(113, $hello eq $Z ) ;
 447
 448 ##ok(76, $k->inflateSetDictionary($dictionary) == Z_OK);
 449 #
 450 #$Z='';
 451 #while (1) {
 452 #    ($Z, $status) = $k->inflate($X) ;
 453 #    last if $status == Z_STREAM_END or $status != Z_OK ;
 454 #print "status=[$status] hello=[$hello] Z=[$Z]\n";
 455 #}
 456 #ok(77, $status == Z_STREAM_END) ;
 457 #ok(78, $hello eq $Z ) ;
 458 #print "status=[$status] hello=[$hello] Z=[$Z]\n";
 459 #
 460 #
 461 ## all done.
 462 #
 463 #
 464 #
 465
 466
 467 # inflate - check remaining buffer after Z_STREAM_END
 468 # ===================================================
 469
 470 {
 471     ok(114, $x = deflateInit(-Level => Z_BEST_COMPRESSION )) ;
 472
 473     ($X, $status) = $x->deflate($hello) ;
 474     ok(115, $status == Z_OK) ;
 475     ($Y, $status) = $x->flush() ;
 476     ok(116, $status == Z_OK) ;
 477     $X .= $Y ;
 478     $x = 0 ;
 479
 480     ok(117, $k = inflateInit() ) ;
 481
 482     my $first = substr($X, 0, 2) ;
 483     my $last  = substr($X, 2) ;
 484     ($Z, $status) = $k->inflate($first);
 485     ok(118, $status == Z_OK) ;
 486     ok(119, $first eq "") ;
 487
 488     $last .= "appendage" ;
 489     my ($T, $status) = $k->inflate($last);
 490     ok(120, $status == Z_STREAM_END) ;
 491     ok(121, $hello eq $Z . $T ) ;
 492     ok(122, $last eq "appendage") ;
 493
 494 }
 495
 496 # memGzip & memGunzip
 497 {
 498     my $name = "test.gz" ;
 499     my $buffer = <<EOM;
 500 some sample
 501 text
 502
 503 EOM
 504
 505     my $len = length $buffer ;
 506     my ($x, $uncomp) ;
 507
 508
 509     # create an in-memory gzip file
 510     my $dest = Compress::Zlib::memGzip($buffer) ;
 511     ok(123, length $dest) ;
 512
 513     # write it to disk
 514     ok(124, open(FH, ">$name")) ;
 515     binmode(FH);
 516     print FH $dest ;
 517     close FH ;
 518
 519     # uncompress with gzopen
 520     ok(125, my $fil = gzopen($name, "rb") ) ;
 521
 522     ok(126, ($x = $fil->gzread($uncomp)) == $len) ;
 523
 524     ok(127, ! $fil->gzclose ) ;
 525
 526     ok(128, $uncomp eq $buffer) ;
 527
 528     unlink $name ;
 529
 530     # now check that memGunzip can deal with it.
 531     my $ungzip = Compress::Zlib::memGunzip($dest) ;
 532     ok(129, defined $ungzip) ;
 533     ok(130, $buffer eq $ungzip) ;
 534
 535     # now do the same but use a reference
 536
 537     $dest = Compress::Zlib::memGzip(\$buffer) ;
 538     ok(131, length $dest) ;
 539
 540     # write it to disk
 541     ok(132, open(FH, ">$name")) ;
 542     binmode(FH);
 543     print FH $dest ;
 544     close FH ;
 545
 546     # uncompress with gzopen
 547     ok(133, $fil = gzopen($name, "rb") ) ;
 548
 549     ok(134, ($x = $fil->gzread($uncomp)) == $len) ;
 550
 551     ok(135, ! $fil->gzclose ) ;
 552
 553     ok(136, $uncomp eq $buffer) ;
 554
 555     # now check that memGunzip can deal with it.
 556     my $keep = $dest;
 557     $ungzip = Compress::Zlib::memGunzip(\$dest) ;
 558     ok(137, defined $ungzip) ;
 559     ok(138, $buffer eq $ungzip) ;
 560
 561     # check memGunzip can cope with missing gzip trailer
 562     my $minimal = substr($keep, 0, -1) ;
 563     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 564     ok(139, defined $ungzip) ;
 565     ok(140, $buffer eq $ungzip) ;
 566
 567     $minimal = substr($keep, 0, -2) ;
 568     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 569     ok(141, defined $ungzip) ;
 570     ok(142, $buffer eq $ungzip) ;
 571
 572     $minimal = substr($keep, 0, -3) ;
 573     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 574     ok(143, defined $ungzip) ;
 575     ok(144, $buffer eq $ungzip) ;
 576
 577     $minimal = substr($keep, 0, -4) ;
 578     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 579     ok(145, defined $ungzip) ;
 580     ok(146, $buffer eq $ungzip) ;
 581
 582     $minimal = substr($keep, 0, -5) ;
 583     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 584     ok(147, defined $ungzip) ;
 585     ok(148, $buffer eq $ungzip) ;
 586
 587     $minimal = substr($keep, 0, -6) ;
 588     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 589     ok(149, defined $ungzip) ;
 590     ok(150, $buffer eq $ungzip) ;
 591
 592     $minimal = substr($keep, 0, -7) ;
 593     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 594     ok(151, defined $ungzip) ;
 595     ok(152, $buffer eq $ungzip) ;
 596
 597     $minimal = substr($keep, 0, -8) ;
 598     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 599     ok(153, defined $ungzip) ;
 600     ok(154, $buffer eq $ungzip) ;
 601
 602     $minimal = substr($keep, 0, -9) ;
 603     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 604     ok(155, ! defined $ungzip) ;
 605
 606
 607     unlink $name ;
 608
 609     # check corrupt header -- too short
 610     $dest = "x" ;
 611     my $result = Compress::Zlib::memGunzip($dest) ;
 612     ok(156, !defined $result) ;
 613
 614     # check corrupt header -- full of junk
 615     $dest = "x" x 200 ;
 616     $result = Compress::Zlib::memGunzip($dest) ;
 617     ok(157, !defined $result) ;
 618 }
 619
 620 # memGunzip with a gzopen created file
 621 {
 622     my $name = "test.gz" ;
 623     my $buffer = <<EOM;
 624 some sample
 625 text
 626
 627 EOM
 628
 629     ok(158, $fil = gzopen($name, "wb")) ;
 630
 631     ok(159, $fil->gzwrite($buffer) == length $buffer) ;
 632
 633     ok(160, ! $fil->gzclose ) ;
 634
 635     my $compr = readFile($name);
 636     ok(161, length $compr) ;
 637     my $unc = Compress::Zlib::memGunzip($compr) ;
 638     ok(162, defined $unc) ;
 639     ok(163, $buffer eq $unc) ;
 640     unlink $name ;
 641 }
 642
 643 {
 644
 645     # Check - MAX_WBITS
 646     # =================
 647
 648     $hello = "Test test test test test";
 649     @hello = split('', $hello) ;
 650
 651     ok(164,  ($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
 652     ok(165, $x) ;
 653     ok(166, $err == Z_OK) ;
 654
 655     $Answer = '';
 656     foreach (@hello)
 657     {
 658         ($X, $status) = $x->deflate($_) ;
 659         last unless $status == Z_OK ;
 660
 661         $Answer .= $X ;
 662     }
 663
 664     ok(167, $status == Z_OK) ;
 665
 666     ok(168,    (($X, $status) = $x->flush())[1] == Z_OK ) ;
 667     $Answer .= $X ;
 668
 669
 670     @Answer = split('', $Answer) ;
 671     # Undocumented corner -- extra byte needed to get inflate to return
 672     # Z_STREAM_END when done.
 673     push @Answer, " " ;
 674
 675     ok(169, ($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
 676     ok(170, $k) ;
 677     ok(171, $err == Z_OK) ;
 678
 679     $GOT = '';
 680     foreach (@Answer)
 681     {
 682         ($Z, $status) = $k->inflate($_) ;
 683         $GOT .= $Z ;
 684         last if $status == Z_STREAM_END or $status != Z_OK ;
 685
 686     }
 687
 688     ok(172, $status == Z_STREAM_END) ;
 689     ok(173, $GOT eq $hello ) ;
 690
 691 }
 692
 693 {
 694     # inflateSync
 695
 696     # create a deflate stream with flush points
 697
 698     my $hello = "I am a HAL 9000 computer" x 2001 ;
 699     my $goodbye = "Will I dream?" x 2010;
 700     my ($err, $answer, $X, $status, $Answer);
 701
 702     ok(174, ($x, $err) = deflateInit() ) ;
 703     ok(175, $x) ;
 704     ok(176, $err == Z_OK) ;
 705
 706     ($Answer, $status) = $x->deflate($hello) ;
 707     ok(177, $status == Z_OK) ;
 708
 709     # create a flush point
 710     ok(178, (($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
 711     $Answer .= $X ;
 712
 713     ($X, $status) = $x->deflate($goodbye) ;
 714     ok(179, $status == Z_OK) ;
 715     $Answer .= $X ;
 716
 717     ok(180, (($X, $status) = $x->flush())[1] == Z_OK ) ;
 718     $Answer .= $X ;
 719
 720     my ($first, @Answer) = split('', $Answer) ;
 721
 722     my $k;
 723     ok(181, ($k, $err) = inflateInit()) ;
 724     ok(182, $k) ;
 725     ok(183, $err == Z_OK) ;
 726
 727     ($Z, $status) = $k->inflate($first) ;
 728     ok(184, $status == Z_OK) ;
 729
 730     # skip to the first flush point.
 731     while (@Answer)
 732     {
 733         my $byte = shift @Answer;
 734         $status = $k->inflateSync($byte) ;
 735         last unless $status == Z_DATA_ERROR;
 736
 737     }
 738
 739     ok(185, $status == Z_OK);
 740
 741     my $GOT = '';
 742     my $Z = '';
 743     foreach (@Answer)
 744     {
 745         my $Z = '';
 746         ($Z, $status) = $k->inflate($_) ;
 747         $GOT .= $Z if defined $Z ;
 748         # print "x $status\n";
 749         last if $status == Z_STREAM_END or $status != Z_OK ;
 750
 751     }
 752
 753     # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR
 754     ok(186, $status == Z_DATA_ERROR || $status == Z_STREAM_END) ;
 755     ok(187, $GOT eq $goodbye ) ;
 756
 757
 758     # Check inflateSync leaves good data in buffer
 759     $Answer =~ /^(.)(.*)$/ ;
 760     my ($initial, $rest) = ($1, $2);
 761
 762
 763     ok(188, ($k, $err) = inflateInit()) ;
 764     ok(189, $k) ;
 765     ok(190, $err == Z_OK) ;
 766
 767     ($Z, $status) = $k->inflate($initial) ;
 768     ok(191, $status == Z_OK) ;
 769
 770     $status = $k->inflateSync($rest) ;
 771     ok(192, $status == Z_OK);
 772
 773     ($GOT, $status) = $k->inflate($rest) ;
 774
 775     ok(193, $status == Z_DATA_ERROR) ;
 776     ok(194, $Z . $GOT eq $goodbye ) ;
 777 }
 778
 779 {
 780     # deflateParams
 781
 782     my $hello = "I am a HAL 9000 computer" x 2001 ;
 783     my $goodbye = "Will I dream?" x 2010;
 784     my ($input, $err, $answer, $X, $status, $Answer);
 785
 786     ok(195, ($x, $err) = deflateInit(-Level    => Z_BEST_COMPRESSION,
 787                                      -Strategy => Z_DEFAULT_STRATEGY) ) ;
 788     ok(196, $x) ;
 789     ok(197, $err == Z_OK) ;
 790
 791     ok(198, $x->get_Level()    == Z_BEST_COMPRESSION);
 792     ok(199, $x->get_Strategy() == Z_DEFAULT_STRATEGY);
 793
 794     ($Answer, $status) = $x->deflate($hello) ;
 795     ok(200, $status == Z_OK) ;
 796     $input .= $hello;
 797
 798     # error cases
 799     eval { $x->deflateParams() };
 800     ok(201, $@ =~ m#^deflateParams needs Level and/or Strategy#);
 801
 802     eval { $x->deflateParams(-Joe => 3) };
 803     ok(202, $@ =~ /^unknown key value\(s\) Joe at/);
 804
 805     ok(203, $x->get_Level()    == Z_BEST_COMPRESSION);
 806     ok(204, $x->get_Strategy() == Z_DEFAULT_STRATEGY);
 807
 808     # change both Level & Strategy
 809     $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
 810     ok(205, $status == Z_OK) ;
 811
 812     ok(206, $x->get_Level()    == Z_BEST_SPEED);
 813     ok(207, $x->get_Strategy() == Z_HUFFMAN_ONLY);
 814
 815     ($X, $status) = $x->deflate($goodbye) ;
 816     ok(208, $status == Z_OK) ;
 817     $Answer .= $X ;
 818     $input .= $goodbye;
 819
 820     # change only Level
 821     $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
 822     ok(209, $status == Z_OK) ;
 823
 824     ok(210, $x->get_Level()    == Z_NO_COMPRESSION);
 825     ok(211, $x->get_Strategy() == Z_HUFFMAN_ONLY);
 826
 827     ($X, $status) = $x->deflate($goodbye) ;
 828     ok(212, $status == Z_OK) ;
 829     $Answer .= $X ;
 830     $input .= $goodbye;
 831
 832     # change only Strategy
 833     $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
 834     ok(213, $status == Z_OK) ;
 835
 836     ok(214, $x->get_Level()    == Z_NO_COMPRESSION);
 837     ok(215, $x->get_Strategy() == Z_FILTERED);
 838
 839     ($X, $status) = $x->deflate($goodbye) ;
 840     ok(216, $status == Z_OK) ;
 841     $Answer .= $X ;
 842     $input .= $goodbye;
 843
 844     ok(217, (($X, $status) = $x->flush())[1] == Z_OK ) ;
 845     $Answer .= $X ;
 846
 847     my ($first, @Answer) = split('', $Answer) ;
 848
 849     my $k;
 850     ok(218, ($k, $err) = inflateInit()) ;
 851     ok(219, $k) ;
 852     ok(220, $err == Z_OK) ;
 853
 854     ($Z, $status) = $k->inflate($Answer) ;
 855
 856     ok(221, $status == Z_STREAM_END) ;
 857     ok(222, $Z  eq $input ) ;
 858 }
 859
 860 {
 861     # error cases
 862
 863     eval { deflateInit(-Level) };
 864     ok(223, $@ =~ /^Compress::Zlib::deflateInit: parameter is not a reference to a hash at/);
 865
 866     eval { inflateInit(-Level) };
 867     ok(224, $@ =~ /^Compress::Zlib::inflateInit: parameter is not a reference to a hash at/);
 868
 869     eval { deflateInit(-Joe => 1) };
 870     ok(225, $@ =~ /^unknown key value\(s\) Joe at/);
 871
 872     eval { inflateInit(-Joe => 1) };
 873     ok(226, $@ =~ /^unknown key value\(s\) Joe at/);
 874
 875     eval { deflateInit(-Bufsize => 0) };
 876     ok(227, $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/);
 877
 878     eval { inflateInit(-Bufsize => 0) };
 879     ok(228, $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/);
 880
 881     eval { deflateInit(-Bufsize => -1) };
 882     ok(229, $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/);
 883
 884     eval { inflateInit(-Bufsize => -1) };
 885     ok(230, $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/);
 886
 887     eval { deflateInit(-Bufsize => "xxx") };
 888     ok(231, $@ =~ /^.*?: Bufsize must be >= 1, you specified xxx at/);
 889
 890     eval { inflateInit(-Bufsize => "xxx") };
 891     ok(232, $@ =~ /^.*?: Bufsize must be >= 1, you specified xxx at/);
 892
 893 }
 894
 895 {
 896     # test inflate with a substr
 897
 898     ok(233, my $x = deflateInit() ) ;
 899
 900     ok(234, (my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
 901
 902     my $Y = $X ;
 903
 904
 905
 906     ok(235, (($X, $status) = $x->flush() )[1] == Z_OK ) ;
 907     $Y .= $X ;
 908
 909     my $append = "Appended" ;
 910     $Y .= $append ;
 911
 912     ok(236, $k = inflateInit() ) ;
 913
 914     ($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
 915
 916     ok(237, $status == Z_STREAM_END) ;
 917     #print "status $status Y [$Y]\n" ;
 918     ok(238, $contents eq $Z ) ;
 919     ok(239, $Y eq $append);
 920
 921 }