ext/Compress/Zlib/t/03zlib-v1.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib");
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15 use Symbol;
  16
  17 BEGIN
  18 {
  19     # use Test::NoWarnings, if available
  20     my $extra = 0 ;
  21     $extra = 1
  22         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  23
  24     my $count = 0 ;
  25     if ($] < 5.005) {
  26         $count = 353 ;
  27     }
  28     else {
  29         $count = 364 ;
  30     }
  31
  32
  33     plan tests => $count + $extra ;
  34
  35     use_ok('Compress::Zlib', 2) ;
  36     use_ok('Compress::Gzip::Constants') ;
  37
  38     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  39 }
  40
  41
  42 my $hello = <<EOM ;
  43 hello world
  44 this is a test
  45 EOM
  46
  47 my $len   = length $hello ;
  48
  49 # Check zlib_version and ZLIB_VERSION are the same.
  50 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  51     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  52
  53 # generate a long random string
  54 my $contents = '' ;
  55 foreach (1 .. 5000)
  56   { $contents .= chr int rand 256 }
  57
  58 my $x ;
  59 my $fil;
  60
  61 # compress/uncompress tests
  62 # =========================
  63
  64 eval { compress([1]); };
  65 ok $@ =~ m#not a scalar reference#
  66     or print "# $@\n" ;;
  67
  68 eval { uncompress([1]); };
  69 ok $@ =~ m#not a scalar reference#
  70     or print "# $@\n" ;;
  71
  72 $hello = "hello mum" ;
  73 my $keep_hello = $hello ;
  74
  75 my $compr = compress($hello) ;
  76 ok $compr ne "" ;
  77
  78 my $keep_compr = $compr ;
  79
  80 my $uncompr = uncompress ($compr) ;
  81
  82 ok $hello eq $uncompr ;
  83
  84 ok $hello eq $keep_hello ;
  85 ok $compr eq $keep_compr ;
  86
  87 # compress a number
  88 $hello = 7890 ;
  89 $keep_hello = $hello ;
  90
  91 $compr = compress($hello) ;
  92 ok $compr ne "" ;
  93
  94 $keep_compr = $compr ;
  95
  96 $uncompr = uncompress ($compr) ;
  97
  98 ok $hello eq $uncompr ;
  99
 100 ok $hello eq $keep_hello ;
 101 ok $compr eq $keep_compr ;
 102
 103 # bigger compress
 104
 105 $compr = compress ($contents) ;
 106 ok $compr ne "" ;
 107
 108 $uncompr = uncompress ($compr) ;
 109
 110 ok $contents eq $uncompr ;
 111
 112 # buffer reference
 113
 114 $compr = compress(\$hello) ;
 115 ok $compr ne "" ;
 116
 117
 118 $uncompr = uncompress (\$compr) ;
 119 ok $hello eq $uncompr ;
 120
 121 # bad level
 122 $compr = compress($hello, 1000) ;
 123 ok ! defined $compr;
 124
 125 # change level
 126 $compr = compress($hello, Z_BEST_COMPRESSION) ;
 127 ok defined $compr;
 128 $uncompr = uncompress (\$compr) ;
 129 ok $hello eq $uncompr ;
 130
 131 # corrupt data
 132 $compr = compress(\$hello) ;
 133 ok $compr ne "" ;
 134
 135 substr($compr,0, 1) = "\xFF";
 136 ok !defined uncompress (\$compr) ;
 137
 138 # deflate/inflate - small buffer
 139 # ==============================
 140
 141 $hello = "I am a HAL 9000 computer" ;
 142 my @hello = split('', $hello) ;
 143 my ($err, $X, $status);
 144
 145 ok  (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
 146 ok $x ;
 147 ok $err == Z_OK ;
 148
 149 my $Answer = '';
 150 foreach (@hello)
 151 {
 152     ($X, $status) = $x->deflate($_) ;
 153     last unless $status == Z_OK ;
 154
 155     $Answer .= $X ;
 156 }
 157
 158 ok $status == Z_OK ;
 159
 160 ok    ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 161 $Answer .= $X ;
 162
 163
 164 my @Answer = split('', $Answer) ;
 165
 166 my $k;
 167 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
 168 ok $k ;
 169 ok $err == Z_OK ;
 170
 171 my $GOT = '';
 172 my $Z;
 173 foreach (@Answer)
 174 {
 175     ($Z, $status) = $k->inflate($_) ;
 176     $GOT .= $Z ;
 177     last if $status == Z_STREAM_END or $status != Z_OK ;
 178
 179 }
 180
 181 ok $status == Z_STREAM_END ;
 182 ok $GOT eq $hello ;
 183
 184
 185 title 'deflate/inflate - small buffer with a number';
 186 # ==============================
 187
 188 $hello = 6529 ;
 189
 190 ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
 191 ok $x ;
 192 ok $err == Z_OK ;
 193
 194 ok !defined $x->msg() ;
 195 ok $x->total_in() == 0 ;
 196 ok $x->total_out() == 0 ;
 197 $Answer = '';
 198 {
 199     ($X, $status) = $x->deflate($hello) ;
 200
 201     $Answer .= $X ;
 202 }
 203
 204 ok $status == Z_OK ;
 205
 206 ok   ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 207 $Answer .= $X ;
 208
 209 ok !defined $x->msg() ;
 210 ok $x->total_in() == length $hello ;
 211 ok $x->total_out() == length $Answer ;
 212
 213
 214 @Answer = split('', $Answer) ;
 215
 216 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
 217 ok $k ;
 218 ok $err == Z_OK ;
 219
 220 ok !defined $k->msg() ;
 221 ok $k->total_in() == 0 ;
 222 ok $k->total_out() == 0 ;
 223
 224 $GOT = '';
 225 foreach (@Answer)
 226 {
 227     ($Z, $status) = $k->inflate($_) ;
 228     $GOT .= $Z ;
 229     last if $status == Z_STREAM_END or $status != Z_OK ;
 230
 231 }
 232
 233 ok $status == Z_STREAM_END ;
 234 ok $GOT eq $hello ;
 235
 236 ok !defined $k->msg() ;
 237 is $k->total_in(), length $Answer ;
 238 ok $k->total_out() == length $hello ;
 239
 240
 241
 242 title 'deflate/inflate - larger buffer';
 243 # ==============================
 244
 245
 246 ok $x = deflateInit() ;
 247
 248 ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
 249
 250 my $Y = $X ;
 251
 252
 253 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
 254 $Y .= $X ;
 255
 256
 257
 258 ok $k = inflateInit() ;
 259
 260 ($Z, $status) = $k->inflate($Y) ;
 261
 262 ok $status == Z_STREAM_END ;
 263 ok $contents eq $Z ;
 264
 265 title 'deflate/inflate - preset dictionary';
 266 # ===================================
 267
 268 my $dictionary = "hello" ;
 269 ok $x = deflateInit({-Level => Z_BEST_COMPRESSION,
 270                          -Dictionary => $dictionary}) ;
 271
 272 my $dictID = $x->dict_adler() ;
 273
 274 ($X, $status) = $x->deflate($hello) ;
 275 ok $status == Z_OK ;
 276 ($Y, $status) = $x->flush() ;
 277 ok $status == Z_OK ;
 278 $X .= $Y ;
 279 $x = 0 ;
 280
 281 ok $k = inflateInit(-Dictionary => $dictionary) ;
 282
 283 ($Z, $status) = $k->inflate($X);
 284 ok $status == Z_STREAM_END ;
 285 ok $k->dict_adler() == $dictID;
 286 ok $hello eq $Z ;
 287
 288 #$Z='';
 289 #while (1) {
 290 #    ($Z, $status) = $k->inflate($X) ;
 291 #    last if $status == Z_STREAM_END or $status != Z_OK ;
 292 #print "status=[$status] hello=[$hello] Z=[$Z]\n";
 293 #}
 294 #ok $status == Z_STREAM_END ;
 295 #ok $hello eq $Z
 296 # or print "status=[$status] hello=[$hello] Z=[$Z]\n";
 297
 298
 299
 300
 301
 302
 303 title 'inflate - check remaining buffer after Z_STREAM_END';
 304 # ===================================================
 305
 306 {
 307     ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ;
 308
 309     ($X, $status) = $x->deflate($hello) ;
 310     ok $status == Z_OK ;
 311     ($Y, $status) = $x->flush() ;
 312     ok $status == Z_OK ;
 313     $X .= $Y ;
 314     $x = 0 ;
 315
 316     ok $k = inflateInit()  ;
 317
 318     my $first = substr($X, 0, 2) ;
 319     my $last  = substr($X, 2) ;
 320     ($Z, $status) = $k->inflate($first);
 321     ok $status == Z_OK ;
 322     ok $first eq "" ;
 323
 324     $last .= "appendage" ;
 325     my $T;
 326     ($T, $status) = $k->inflate($last);
 327     ok $status == Z_STREAM_END ;
 328     ok $hello eq $Z . $T ;
 329     ok $last eq "appendage" ;
 330
 331 }
 332
 333 title 'memGzip & memGunzip';
 334 {
 335     my $name = "test.gz" ;
 336     my $buffer = <<EOM;
 337 some sample
 338 text
 339
 340 EOM
 341
 342     my $len = length $buffer ;
 343     my ($x, $uncomp) ;
 344
 345
 346     # create an in-memory gzip file
 347     my $dest = Compress::Zlib::memGzip($buffer) ;
 348     ok length $dest ;
 349
 350     # write it to disk
 351     ok open(FH, ">$name") ;
 352     binmode(FH);
 353     print FH $dest ;
 354     close FH ;
 355
 356     # uncompress with gzopen
 357     ok my $fil = gzopen($name, "rb") ;
 358
 359     is $fil->gzread($uncomp, 0), 0 ;
 360     ok (($x = $fil->gzread($uncomp)) == $len) ;
 361
 362     ok ! $fil->gzclose ;
 363
 364     ok $uncomp eq $buffer ;
 365
 366     unlink $name ;
 367
 368     # now check that memGunzip can deal with it.
 369     my $ungzip = Compress::Zlib::memGunzip($dest) ;
 370     ok defined $ungzip ;
 371     ok $buffer eq $ungzip ;
 372
 373     # now do the same but use a reference
 374
 375     $dest = Compress::Zlib::memGzip(\$buffer) ;
 376     ok length $dest ;
 377
 378     # write it to disk
 379     ok open(FH, ">$name") ;
 380     binmode(FH);
 381     print FH $dest ;
 382     close FH ;
 383
 384     # uncompress with gzopen
 385     ok $fil = gzopen($name, "rb") ;
 386
 387     ok (($x = $fil->gzread($uncomp)) == $len) ;
 388
 389     ok ! $fil->gzclose ;
 390
 391     ok $uncomp eq $buffer ;
 392
 393     # now check that memGunzip can deal with it.
 394     my $keep = $dest;
 395     $ungzip = Compress::Zlib::memGunzip(\$dest) ;
 396     ok defined $ungzip ;
 397     ok $buffer eq $ungzip ;
 398
 399     # check memGunzip can cope with missing gzip trailer
 400     my $minimal = substr($keep, 0, -1) ;
 401     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 402     ok defined $ungzip ;
 403     ok $buffer eq $ungzip ;
 404
 405     $minimal = substr($keep, 0, -2) ;
 406     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 407     ok defined $ungzip ;
 408     ok $buffer eq $ungzip ;
 409
 410     $minimal = substr($keep, 0, -3) ;
 411     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 412     ok defined $ungzip ;
 413     ok $buffer eq $ungzip ;
 414
 415     $minimal = substr($keep, 0, -4) ;
 416     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 417     ok defined $ungzip ;
 418     ok $buffer eq $ungzip ;
 419
 420     $minimal = substr($keep, 0, -5) ;
 421     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 422     ok defined $ungzip ;
 423     ok $buffer eq $ungzip ;
 424
 425     $minimal = substr($keep, 0, -6) ;
 426     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 427     ok defined $ungzip ;
 428     ok $buffer eq $ungzip ;
 429
 430     $minimal = substr($keep, 0, -7) ;
 431     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 432     ok defined $ungzip ;
 433     ok $buffer eq $ungzip ;
 434
 435     $minimal = substr($keep, 0, -8) ;
 436     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 437     ok defined $ungzip ;
 438     ok $buffer eq $ungzip ;
 439
 440     $minimal = substr($keep, 0, -9) ;
 441     $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
 442     ok ! defined $ungzip ;
 443
 444
 445     unlink $name ;
 446
 447     # check corrupt header -- too short
 448     $dest = "x" ;
 449     my $result = Compress::Zlib::memGunzip($dest) ;
 450     ok !defined $result ;
 451
 452     # check corrupt header -- full of junk
 453     $dest = "x" x 200 ;
 454     $result = Compress::Zlib::memGunzip($dest) ;
 455     ok !defined $result ;
 456
 457     # corrupt header - 1st byte wrong
 458     my $bad = $keep ;
 459     substr($bad, 0, 1) = "\xFF" ;
 460     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 461     ok ! defined $ungzip ;
 462
 463     # corrupt header - 2st byte wrong
 464     $bad = $keep ;
 465     substr($bad, 1, 1) = "\xFF" ;
 466     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 467     ok ! defined $ungzip ;
 468
 469     # corrupt header - method not deflated
 470     $bad = $keep ;
 471     substr($bad, 2, 1) = "\xFF" ;
 472     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 473     ok ! defined $ungzip ;
 474
 475     # corrupt header - reserverd bits used
 476     $bad = $keep ;
 477     substr($bad, 3, 1) = "\xFF" ;
 478     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 479     ok ! defined $ungzip ;
 480
 481     # corrupt trailer - length wrong
 482     $bad = $keep ;
 483     substr($bad, -8, 4) = "\xFF" x 4 ;
 484     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 485     ok ! defined $ungzip ;
 486
 487     # corrupt trailer - CRC wrong
 488     $bad = $keep ;
 489     substr($bad, -4, 4) = "\xFF" x 4 ;
 490     $ungzip = Compress::Zlib::memGunzip(\$bad) ;
 491     ok ! defined $ungzip ;
 492 }
 493
 494 {
 495     title "Check all bytes can be handled";
 496
 497     my $lex = "\r\n" . new LexFile my $name ;
 498     my $data = join '', map { chr } 0x00 .. 0xFF;
 499     $data .= "\r\nabd\r\n";
 500
 501     my $fil;
 502     ok $fil = gzopen($name, "wb") ;
 503     is $fil->gzwrite($data), length $data ;
 504     ok ! $fil->gzclose();
 505
 506     my $input;
 507     ok $fil = gzopen($name, "rb") ;
 508     is $fil->gzread($input), length $data ;
 509     ok ! $fil->gzclose();
 510     ok $input eq $data;
 511
 512     title "Check all bytes can be handled - transparent mode";
 513     writeFile($name, $data);
 514     ok $fil = gzopen($name, "rb") ;
 515     is $fil->gzread($input), length $data ;
 516     ok ! $fil->gzclose();
 517     ok $input eq $data;
 518
 519 }
 520
 521 title 'memGunzip with a gzopen created file';
 522 {
 523     my $name = "test.gz" ;
 524     my $buffer = <<EOM;
 525 some sample
 526 text
 527
 528 EOM
 529
 530     ok $fil = gzopen($name, "wb") ;
 531
 532     ok $fil->gzwrite($buffer) == length $buffer ;
 533
 534     ok ! $fil->gzclose ;
 535
 536     my $compr = readFile($name);
 537     ok length $compr ;
 538     my $unc = Compress::Zlib::memGunzip($compr) ;
 539     ok defined $unc ;
 540     ok $buffer eq $unc ;
 541     unlink $name ;
 542 }
 543
 544 {
 545
 546     # Check - MAX_WBITS
 547     # =================
 548
 549     $hello = "Test test test test test";
 550     @hello = split('', $hello) ;
 551
 552     ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
 553     ok $x ;
 554     ok $err == Z_OK ;
 555
 556     $Answer = '';
 557     foreach (@hello)
 558     {
 559         ($X, $status) = $x->deflate($_) ;
 560         last unless $status == Z_OK ;
 561
 562         $Answer .= $X ;
 563     }
 564
 565     ok $status == Z_OK ;
 566
 567     ok   ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 568     $Answer .= $X ;
 569
 570
 571     @Answer = split('', $Answer) ;
 572     # Undocumented corner -- extra byte needed to get inflate to return
 573     # Z_STREAM_END when done.
 574     push @Answer, " " ;
 575
 576     ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
 577     ok $k ;
 578     ok $err == Z_OK ;
 579
 580     $GOT = '';
 581     foreach (@Answer)
 582     {
 583         ($Z, $status) = $k->inflate($_) ;
 584         $GOT .= $Z ;
 585         last if $status == Z_STREAM_END or $status != Z_OK ;
 586
 587     }
 588
 589     ok $status == Z_STREAM_END ;
 590     ok $GOT eq $hello ;
 591
 592 }
 593
 594 {
 595     # inflateSync
 596
 597     # create a deflate stream with flush points
 598
 599     my $hello = "I am a HAL 9000 computer" x 2001 ;
 600     my $goodbye = "Will I dream?" x 2010;
 601     my ($err, $answer, $X, $status, $Answer);
 602
 603     ok (($x, $err) = deflateInit() ) ;
 604     ok $x ;
 605     ok $err == Z_OK ;
 606
 607     ($Answer, $status) = $x->deflate($hello) ;
 608     ok $status == Z_OK ;
 609
 610     # create a flush point
 611     ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
 612     $Answer .= $X ;
 613
 614     ($X, $status) = $x->deflate($goodbye) ;
 615     ok $status == Z_OK ;
 616     $Answer .= $X ;
 617
 618     ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 619     $Answer .= $X ;
 620
 621     my ($first, @Answer) = split('', $Answer) ;
 622
 623     my $k;
 624     ok (($k, $err) = inflateInit()) ;
 625     ok $k ;
 626     ok $err == Z_OK ;
 627
 628     ($Z, $status) = $k->inflate($first) ;
 629     ok $status == Z_OK ;
 630
 631     # skip to the first flush point.
 632     while (@Answer)
 633     {
 634         my $byte = shift @Answer;
 635         $status = $k->inflateSync($byte) ;
 636         last unless $status == Z_DATA_ERROR;
 637
 638     }
 639
 640     ok $status == Z_OK;
 641
 642     my $GOT = '';
 643     my $Z = '';
 644     foreach (@Answer)
 645     {
 646         my $Z = '';
 647         ($Z, $status) = $k->inflate($_) ;
 648         $GOT .= $Z if defined $Z ;
 649         # print "x $status\n";
 650         last if $status == Z_STREAM_END or $status != Z_OK ;
 651
 652     }
 653
 654     # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR
 655     ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ;
 656     ok $GOT eq $goodbye ;
 657
 658
 659     # Check inflateSync leaves good data in buffer
 660     $Answer =~ /^(.)(.*)$/ ;
 661     my ($initial, $rest) = ($1, $2);
 662
 663
 664     ok (($k, $err) = inflateInit()) ;
 665     ok $k ;
 666     ok $err == Z_OK ;
 667
 668     ($Z, $status) = $k->inflate($initial) ;
 669     ok $status == Z_OK ;
 670
 671     $status = $k->inflateSync($rest) ;
 672     ok $status == Z_OK;
 673
 674     ($GOT, $status) = $k->inflate($rest) ;
 675
 676     ok $status == Z_DATA_ERROR ;
 677     ok $Z . $GOT eq $goodbye ;
 678 }
 679
 680 {
 681     # deflateParams
 682
 683     my $hello = "I am a HAL 9000 computer" x 2001 ;
 684     my $goodbye = "Will I dream?" x 2010;
 685     my ($input, $err, $answer, $X, $status, $Answer);
 686
 687     ok (($x, $err) = deflateInit(-Level    => Z_BEST_COMPRESSION,
 688                                      -Strategy => Z_DEFAULT_STRATEGY) ) ;
 689     ok $x ;
 690     ok $err == Z_OK ;
 691
 692     ok $x->get_Level()    == Z_BEST_COMPRESSION;
 693     ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
 694
 695     ($Answer, $status) = $x->deflate($hello) ;
 696     ok $status == Z_OK ;
 697     $input .= $hello;
 698
 699     # error cases
 700     eval { $x->deflateParams() };
 701     ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#;
 702
 703     eval { $x->deflateParams(-Joe => 3) };
 704     ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
 705         or print "# $@\n" ;
 706
 707     ok $x->get_Level()    == Z_BEST_COMPRESSION;
 708     ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
 709
 710     # change both Level & Strategy
 711     $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
 712     ok $status == Z_OK ;
 713
 714     ok $x->get_Level()    == Z_BEST_SPEED;
 715     ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
 716
 717     ($X, $status) = $x->deflate($goodbye) ;
 718     ok $status == Z_OK ;
 719     $Answer .= $X ;
 720     $input .= $goodbye;
 721
 722     # change only Level
 723     $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
 724     ok $status == Z_OK ;
 725
 726     ok $x->get_Level()    == Z_NO_COMPRESSION;
 727     ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
 728
 729     ($X, $status) = $x->deflate($goodbye) ;
 730     ok $status == Z_OK ;
 731     $Answer .= $X ;
 732     $input .= $goodbye;
 733
 734     # change only Strategy
 735     $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
 736     ok $status == Z_OK ;
 737
 738     ok $x->get_Level()    == Z_NO_COMPRESSION;
 739     ok $x->get_Strategy() == Z_FILTERED;
 740
 741     ($X, $status) = $x->deflate($goodbye) ;
 742     ok $status == Z_OK ;
 743     $Answer .= $X ;
 744     $input .= $goodbye;
 745
 746     ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 747     $Answer .= $X ;
 748
 749     my ($first, @Answer) = split('', $Answer) ;
 750
 751     my $k;
 752     ok (($k, $err) = inflateInit()) ;
 753     ok $k ;
 754     ok $err == Z_OK ;
 755
 756     ($Z, $status) = $k->inflate($Answer) ;
 757
 758     ok $status == Z_STREAM_END
 759         or print "# status $status\n";
 760     ok $Z  eq $input ;
 761 }
 762
 763 {
 764     # error cases
 765
 766     eval { deflateInit(-Level) };
 767     like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';
 768
 769     eval { inflateInit(-Level) };
 770     like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';
 771
 772     eval { deflateInit(-Joe => 1) };
 773     ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;
 774
 775     eval { inflateInit(-Joe => 1) };
 776     ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;
 777
 778     eval { deflateInit(-Bufsize => 0) };
 779     ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
 780
 781     eval { inflateInit(-Bufsize => 0) };
 782     ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
 783
 784     eval { deflateInit(-Bufsize => -1) };
 785     #ok $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/;
 786     ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
 787
 788     eval { inflateInit(-Bufsize => -1) };
 789     ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
 790
 791     eval { deflateInit(-Bufsize => "xxx") };
 792     ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
 793
 794     eval { inflateInit(-Bufsize => "xxx") };
 795     ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
 796
 797     eval { gzopen([], 0) ; }  ;
 798     ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
 799         or print "# $@\n" ;
 800
 801     my $x = Symbol::gensym() ;
 802     eval { gzopen($x, 0) ; }  ;
 803     ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
 804         or print "# $@\n" ;
 805
 806 }
 807
 808 if ($] >= 5.005)
 809 {
 810     # test inflate with a substr
 811
 812     ok my $x = deflateInit() ;
 813
 814     ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
 815
 816     my $Y = $X ;
 817
 818
 819
 820     ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
 821     $Y .= $X ;
 822
 823     my $append = "Appended" ;
 824     $Y .= $append ;
 825
 826     ok $k = inflateInit() ;
 827
 828     #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
 829     ($Z, $status) = $k->inflate(substr($Y, 0)) ;
 830
 831     ok $status == Z_STREAM_END ;
 832     ok $contents eq $Z ;
 833     is $Y, $append;
 834
 835 }
 836
 837 if ($] >= 5.005)
 838 {
 839     # deflate/inflate in scalar context
 840
 841     ok my $x = deflateInit() ;
 842
 843     my $X = $x->deflate($contents);
 844
 845     my $Y = $X ;
 846
 847
 848
 849     $X = $x->flush();
 850     $Y .= $X ;
 851
 852     my $append = "Appended" ;
 853     $Y .= $append ;
 854
 855     ok $k = inflateInit() ;
 856
 857     #$Z = $k->inflate(substr($Y, 0, -1)) ;
 858     $Z = $k->inflate(substr($Y, 0)) ;
 859
 860     ok $contents eq $Z ;
 861     is $Y, $append;
 862
 863 }
 864
 865 {
 866     title 'CRC32' ;
 867
 868     my $data = 'ZgRNtjgSUW'; # CRC32 of this data should have the high bit set
 869     my $expected_crc = 0xCF707A2B ; # 3480255019
 870     my $crc = crc32($data) ;
 871     is $crc, $expected_crc;
 872 }
 873
 874 {
 875     title 'Adler32' ;
 876
 877     my $data = 'lpscOVsAJiUfNComkOfWYBcPhHZ[bT'; # adler of this data should have the high bit set
 878     my $expected_crc = 0xAAD60AC7 ; # 2866154183
 879     my $crc = adler32($data) ;
 880     is $crc, $expected_crc;
 881 }
 882
 883 {
 884     # memGunzip - input > 4K
 885
 886     my $contents = '' ;
 887     foreach (1 .. 20000)
 888       { $contents .= chr int rand 256 }
 889
 890     ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
 891
 892     ok length $compressed > 4096 ;
 893     ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
 894
 895     ok $contents eq $out ;
 896     is length $out, length $contents ;
 897
 898
 899 }
 900
 901
 902 {
 903     # memGunzip Header Corruption Tests
 904
 905     my $string = <<EOM;
 906 some text
 907 EOM
 908
 909     my $good ;
 910     ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
 911     ok $x->write($string) ;
 912     ok  $x->close ;
 913
 914     {
 915         title "Header Corruption - Fingerprint wrong 1st byte" ;
 916         my $buffer = $good ;
 917         substr($buffer, 0, 1) = 'x' ;
 918
 919         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 920     }
 921
 922     {
 923         title "Header Corruption - Fingerprint wrong 2nd byte" ;
 924         my $buffer = $good ;
 925         substr($buffer, 1, 1) = "\xFF" ;
 926
 927         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 928     }
 929
 930     {
 931         title "Header Corruption - CM not 8";
 932         my $buffer = $good ;
 933         substr($buffer, 2, 1) = 'x' ;
 934
 935         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 936     }
 937
 938     {
 939         title "Header Corruption - Use of Reserved Flags";
 940         my $buffer = $good ;
 941         substr($buffer, 3, 1) = "\xff";
 942
 943         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 944     }
 945
 946 }
 947
 948 for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
 949 {
 950     title "Header Corruption - Truncated in Extra";
 951     my $string = <<EOM;
 952 some text
 953 EOM
 954
 955     my $truncated ;
 956     ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0,
 957                                 -ExtraField => "hello" x 10  ;
 958     ok  $x->write($string) ;
 959     ok  $x->close ;
 960
 961     substr($truncated, $index) = '' ;
 962
 963     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 964
 965
 966 }
 967
 968 my $Name = "fred" ;
 969 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
 970 {
 971     title "Header Corruption - Truncated in Name";
 972     my $string = <<EOM;
 973 some text
 974 EOM
 975
 976     my $truncated ;
 977     ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
 978     ok  $x->write($string) ;
 979     ok  $x->close ;
 980
 981     substr($truncated, $index) = '' ;
 982
 983     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 984 }
 985
 986 my $Comment = "comment" ;
 987 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
 988 {
 989     title "Header Corruption - Truncated in Comment";
 990     my $string = <<EOM;
 991 some text
 992 EOM
 993
 994     my $truncated ;
 995     ok  my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
 996     ok  $x->write($string) ;
 997     ok  $x->close ;
 998
 999     substr($truncated, $index) = '' ;
1000     ok ! Compress::Zlib::memGunzip(\$truncated) ;
1001 }
1002
1003 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
1004 {
1005     title "Header Corruption - Truncated in CRC";
1006     my $string = <<EOM;
1007 some text
1008 EOM
1009
1010     my $truncated ;
1011     ok  my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
1012     ok  $x->write($string) ;
1013     ok  $x->close ;
1014
1015     substr($truncated, $index) = '' ;
1016
1017     ok ! Compress::Zlib::memGunzip(\$truncated) ;
1018 }
1019
1020 {
1021     title "memGunzip can cope with a gzip header with all possible fields";
1022     my $string = <<EOM;
1023 some text
1024 EOM
1025
1026     my $buffer ;
1027     ok  my $x = new IO::Compress::Gzip \$buffer,
1028                              -Append     => 1,
1029                              -Strict     => 0,
1030                              -HeaderCRC  => 1,
1031                              -Name       => "Fred",
1032                              -ExtraField => "Extra",
1033                              -Comment    => 'Comment';
1034     ok  $x->write($string) ;
1035     ok  $x->close ;
1036
1037     ok defined $buffer ;
1038
1039     ok my $got = Compress::Zlib::memGunzip($buffer)
1040         or diag "gzerrno is $gzerrno" ;
1041     is $got, $string ;
1042 }
1043
1044
1045 {
1046     # Trailer Corruption tests
1047
1048     my $string = <<EOM;
1049 some text
1050 EOM
1051
1052     my $good ;
1053     ok  my $x = new IO::Compress::Gzip \$good, Append => 1 ;
1054     ok  $x->write($string) ;
1055     ok  $x->close ;
1056
1057     foreach my $trim (-8 .. -1)
1058     {
1059         my $got = $trim + 8 ;
1060         title "Trailer Corruption - Trailer truncated to $got bytes" ;
1061         my $buffer = $good ;
1062
1063         substr($buffer, $trim) = '';
1064
1065         ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
1066         ok $u eq $string;
1067
1068     }
1069
1070     {
1071         title "Trailer Corruption - Length Wrong, CRC Correct" ;
1072         my $buffer = $good ;
1073         substr($buffer, -4, 4) = pack('V', 1234);
1074
1075         ok ! Compress::Zlib::memGunzip(\$buffer) ;
1076     }
1077
1078     {
1079         title "Trailer Corruption - Length Wrong, CRC Wrong" ;
1080         my $buffer = $good ;
1081         substr($buffer, -4, 4) = pack('V', 1234);
1082         substr($buffer, -8, 4) = pack('V', 1234);
1083
1084         ok ! Compress::Zlib::memGunzip(\$buffer) ;
1085
1086     }
1087 }
1088
1089
1090
1091