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

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = '../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 = 340 ;
  27     }
  28     else {
  29         $count = 351 ;
  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 title 'memGunzip with a gzopen created file';
 495 {
 496     my $name = "test.gz" ;
 497     my $buffer = <<EOM;
 498 some sample
 499 text
 500
 501 EOM
 502
 503     ok $fil = gzopen($name, "wb") ;
 504
 505     ok $fil->gzwrite($buffer) == length $buffer ;
 506
 507     ok ! $fil->gzclose ;
 508
 509     my $compr = readFile($name);
 510     ok length $compr ;
 511     my $unc = Compress::Zlib::memGunzip($compr) ;
 512     ok defined $unc ;
 513     ok $buffer eq $unc ;
 514     unlink $name ;
 515 }
 516
 517 {
 518
 519     # Check - MAX_WBITS
 520     # =================
 521
 522     $hello = "Test test test test test";
 523     @hello = split('', $hello) ;
 524
 525     ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
 526     ok $x ;
 527     ok $err == Z_OK ;
 528
 529     $Answer = '';
 530     foreach (@hello)
 531     {
 532         ($X, $status) = $x->deflate($_) ;
 533         last unless $status == Z_OK ;
 534
 535         $Answer .= $X ;
 536     }
 537
 538     ok $status == Z_OK ;
 539
 540     ok   ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 541     $Answer .= $X ;
 542
 543
 544     @Answer = split('', $Answer) ;
 545     # Undocumented corner -- extra byte needed to get inflate to return
 546     # Z_STREAM_END when done.
 547     push @Answer, " " ;
 548
 549     ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
 550     ok $k ;
 551     ok $err == Z_OK ;
 552
 553     $GOT = '';
 554     foreach (@Answer)
 555     {
 556         ($Z, $status) = $k->inflate($_) ;
 557         $GOT .= $Z ;
 558         last if $status == Z_STREAM_END or $status != Z_OK ;
 559
 560     }
 561
 562     ok $status == Z_STREAM_END ;
 563     ok $GOT eq $hello ;
 564
 565 }
 566
 567 {
 568     # inflateSync
 569
 570     # create a deflate stream with flush points
 571
 572     my $hello = "I am a HAL 9000 computer" x 2001 ;
 573     my $goodbye = "Will I dream?" x 2010;
 574     my ($err, $answer, $X, $status, $Answer);
 575
 576     ok (($x, $err) = deflateInit() ) ;
 577     ok $x ;
 578     ok $err == Z_OK ;
 579
 580     ($Answer, $status) = $x->deflate($hello) ;
 581     ok $status == Z_OK ;
 582
 583     # create a flush point
 584     ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
 585     $Answer .= $X ;
 586
 587     ($X, $status) = $x->deflate($goodbye) ;
 588     ok $status == Z_OK ;
 589     $Answer .= $X ;
 590
 591     ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 592     $Answer .= $X ;
 593
 594     my ($first, @Answer) = split('', $Answer) ;
 595
 596     my $k;
 597     ok (($k, $err) = inflateInit()) ;
 598     ok $k ;
 599     ok $err == Z_OK ;
 600
 601     ($Z, $status) = $k->inflate($first) ;
 602     ok $status == Z_OK ;
 603
 604     # skip to the first flush point.
 605     while (@Answer)
 606     {
 607         my $byte = shift @Answer;
 608         $status = $k->inflateSync($byte) ;
 609         last unless $status == Z_DATA_ERROR;
 610
 611     }
 612
 613     ok $status == Z_OK;
 614
 615     my $GOT = '';
 616     my $Z = '';
 617     foreach (@Answer)
 618     {
 619         my $Z = '';
 620         ($Z, $status) = $k->inflate($_) ;
 621         $GOT .= $Z if defined $Z ;
 622         # print "x $status\n";
 623         last if $status == Z_STREAM_END or $status != Z_OK ;
 624
 625     }
 626
 627     # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR
 628     ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ;
 629     ok $GOT eq $goodbye ;
 630
 631
 632     # Check inflateSync leaves good data in buffer
 633     $Answer =~ /^(.)(.*)$/ ;
 634     my ($initial, $rest) = ($1, $2);
 635
 636
 637     ok (($k, $err) = inflateInit()) ;
 638     ok $k ;
 639     ok $err == Z_OK ;
 640
 641     ($Z, $status) = $k->inflate($initial) ;
 642     ok $status == Z_OK ;
 643
 644     $status = $k->inflateSync($rest) ;
 645     ok $status == Z_OK;
 646
 647     ($GOT, $status) = $k->inflate($rest) ;
 648
 649     ok $status == Z_DATA_ERROR ;
 650     ok $Z . $GOT eq $goodbye ;
 651 }
 652
 653 {
 654     # deflateParams
 655
 656     my $hello = "I am a HAL 9000 computer" x 2001 ;
 657     my $goodbye = "Will I dream?" x 2010;
 658     my ($input, $err, $answer, $X, $status, $Answer);
 659
 660     ok (($x, $err) = deflateInit(-Level    => Z_BEST_COMPRESSION,
 661                                      -Strategy => Z_DEFAULT_STRATEGY) ) ;
 662     ok $x ;
 663     ok $err == Z_OK ;
 664
 665     ok $x->get_Level()    == Z_BEST_COMPRESSION;
 666     ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
 667
 668     ($Answer, $status) = $x->deflate($hello) ;
 669     ok $status == Z_OK ;
 670     $input .= $hello;
 671
 672     # error cases
 673     eval { $x->deflateParams() };
 674     ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#;
 675
 676     eval { $x->deflateParams(-Joe => 3) };
 677     ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
 678         or print "# $@\n" ;
 679
 680     ok $x->get_Level()    == Z_BEST_COMPRESSION;
 681     ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
 682
 683     # change both Level & Strategy
 684     $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
 685     ok $status == Z_OK ;
 686
 687     ok $x->get_Level()    == Z_BEST_SPEED;
 688     ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
 689
 690     ($X, $status) = $x->deflate($goodbye) ;
 691     ok $status == Z_OK ;
 692     $Answer .= $X ;
 693     $input .= $goodbye;
 694
 695     # change only Level
 696     $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
 697     ok $status == Z_OK ;
 698
 699     ok $x->get_Level()    == Z_NO_COMPRESSION;
 700     ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
 701
 702     ($X, $status) = $x->deflate($goodbye) ;
 703     ok $status == Z_OK ;
 704     $Answer .= $X ;
 705     $input .= $goodbye;
 706
 707     # change only Strategy
 708     $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
 709     ok $status == Z_OK ;
 710
 711     ok $x->get_Level()    == Z_NO_COMPRESSION;
 712     ok $x->get_Strategy() == Z_FILTERED;
 713
 714     ($X, $status) = $x->deflate($goodbye) ;
 715     ok $status == Z_OK ;
 716     $Answer .= $X ;
 717     $input .= $goodbye;
 718
 719     ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
 720     $Answer .= $X ;
 721
 722     my ($first, @Answer) = split('', $Answer) ;
 723
 724     my $k;
 725     ok (($k, $err) = inflateInit()) ;
 726     ok $k ;
 727     ok $err == Z_OK ;
 728
 729     ($Z, $status) = $k->inflate($Answer) ;
 730
 731     ok $status == Z_STREAM_END
 732         or print "# status $status\n";
 733     ok $Z  eq $input ;
 734 }
 735
 736 {
 737     # error cases
 738
 739     eval { deflateInit(-Level) };
 740     like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';
 741
 742     eval { inflateInit(-Level) };
 743     like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';
 744
 745     eval { deflateInit(-Joe => 1) };
 746     ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;
 747
 748     eval { inflateInit(-Joe => 1) };
 749     ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;
 750
 751     eval { deflateInit(-Bufsize => 0) };
 752     ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
 753
 754     eval { inflateInit(-Bufsize => 0) };
 755     ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
 756
 757     eval { deflateInit(-Bufsize => -1) };
 758     #ok $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/;
 759     ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
 760
 761     eval { inflateInit(-Bufsize => -1) };
 762     ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
 763
 764     eval { deflateInit(-Bufsize => "xxx") };
 765     ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
 766
 767     eval { inflateInit(-Bufsize => "xxx") };
 768     ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
 769
 770     eval { gzopen([], 0) ; }  ;
 771     ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
 772         or print "# $@\n" ;
 773
 774     my $x = Symbol::gensym() ;
 775     eval { gzopen($x, 0) ; }  ;
 776     ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
 777         or print "# $@\n" ;
 778
 779 }
 780
 781 if ($] >= 5.005)
 782 {
 783     # test inflate with a substr
 784
 785     ok my $x = deflateInit() ;
 786
 787     ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
 788
 789     my $Y = $X ;
 790
 791
 792
 793     ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
 794     $Y .= $X ;
 795
 796     my $append = "Appended" ;
 797     $Y .= $append ;
 798
 799     ok $k = inflateInit() ;
 800
 801     #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
 802     ($Z, $status) = $k->inflate(substr($Y, 0)) ;
 803
 804     ok $status == Z_STREAM_END ;
 805     ok $contents eq $Z ;
 806     is $Y, $append;
 807
 808 }
 809
 810 if ($] >= 5.005)
 811 {
 812     # deflate/inflate in scalar context
 813
 814     ok my $x = deflateInit() ;
 815
 816     my $X = $x->deflate($contents);
 817
 818     my $Y = $X ;
 819
 820
 821
 822     $X = $x->flush();
 823     $Y .= $X ;
 824
 825     my $append = "Appended" ;
 826     $Y .= $append ;
 827
 828     ok $k = inflateInit() ;
 829
 830     #$Z = $k->inflate(substr($Y, 0, -1)) ;
 831     $Z = $k->inflate(substr($Y, 0)) ;
 832
 833     ok $contents eq $Z ;
 834     is $Y, $append;
 835
 836 }
 837
 838 {
 839     title 'CRC32' ;
 840
 841     my $data = 'ZgRNtjgSUW'; # CRC32 of this data should have the high bit set
 842     my $expected_crc = 0xCF707A2B ; # 3480255019
 843     my $crc = crc32($data) ;
 844     is $crc, $expected_crc;
 845 }
 846
 847 {
 848     title 'Adler32' ;
 849
 850     my $data = 'lpscOVsAJiUfNComkOfWYBcPhHZ[bT'; # adler of this data should have the high bit set
 851     my $expected_crc = 0xAAD60AC7 ; # 2866154183
 852     my $crc = adler32($data) ;
 853     is $crc, $expected_crc;
 854 }
 855
 856 {
 857     # memGunzip - input > 4K
 858
 859     my $contents = '' ;
 860     foreach (1 .. 20000)
 861       { $contents .= chr int rand 256 }
 862
 863     ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
 864
 865     ok length $compressed > 4096 ;
 866     ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
 867
 868     ok $contents eq $out ;
 869     is length $out, length $contents ;
 870
 871
 872 }
 873
 874
 875 {
 876     # memGunzip Header Corruption Tests
 877
 878     my $string = <<EOM;
 879 some text
 880 EOM
 881
 882     my $good ;
 883     ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
 884     ok $x->write($string) ;
 885     ok  $x->close ;
 886
 887     {
 888         title "Header Corruption - Fingerprint wrong 1st byte" ;
 889         my $buffer = $good ;
 890         substr($buffer, 0, 1) = 'x' ;
 891
 892         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 893     }
 894
 895     {
 896         title "Header Corruption - Fingerprint wrong 2nd byte" ;
 897         my $buffer = $good ;
 898         substr($buffer, 1, 1) = "\xFF" ;
 899
 900         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 901     }
 902
 903     {
 904         title "Header Corruption - CM not 8";
 905         my $buffer = $good ;
 906         substr($buffer, 2, 1) = 'x' ;
 907
 908         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 909     }
 910
 911     {
 912         title "Header Corruption - Use of Reserved Flags";
 913         my $buffer = $good ;
 914         substr($buffer, 3, 1) = "\xff";
 915
 916         ok ! Compress::Zlib::memGunzip(\$buffer) ;
 917     }
 918
 919 }
 920
 921 for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
 922 {
 923     title "Header Corruption - Truncated in Extra";
 924     my $string = <<EOM;
 925 some text
 926 EOM
 927
 928     my $truncated ;
 929     ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0,
 930                                 -ExtraField => "hello" x 10  ;
 931     ok  $x->write($string) ;
 932     ok  $x->close ;
 933
 934     substr($truncated, $index) = '' ;
 935
 936     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 937
 938
 939 }
 940
 941 my $Name = "fred" ;
 942 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
 943 {
 944     title "Header Corruption - Truncated in Name";
 945     my $string = <<EOM;
 946 some text
 947 EOM
 948
 949     my $truncated ;
 950     ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
 951     ok  $x->write($string) ;
 952     ok  $x->close ;
 953
 954     substr($truncated, $index) = '' ;
 955
 956     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 957 }
 958
 959 my $Comment = "comment" ;
 960 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
 961 {
 962     title "Header Corruption - Truncated in Comment";
 963     my $string = <<EOM;
 964 some text
 965 EOM
 966
 967     my $truncated ;
 968     ok  my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
 969     ok  $x->write($string) ;
 970     ok  $x->close ;
 971
 972     substr($truncated, $index) = '' ;
 973     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 974 }
 975
 976 for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
 977 {
 978     title "Header Corruption - Truncated in CRC";
 979     my $string = <<EOM;
 980 some text
 981 EOM
 982
 983     my $truncated ;
 984     ok  my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
 985     ok  $x->write($string) ;
 986     ok  $x->close ;
 987
 988     substr($truncated, $index) = '' ;
 989
 990     ok ! Compress::Zlib::memGunzip(\$truncated) ;
 991 }
 992
 993 {
 994     title "memGunzip can cope with a gzip header with all possible fields";
 995     my $string = <<EOM;
 996 some text
 997 EOM
 998
 999     my $buffer ;
1000     ok  my $x = new IO::Compress::Gzip \$buffer,
1001                              -Append     => 1,
1002                              -Strict     => 0,
1003                              -HeaderCRC  => 1,
1004                              -Name       => "Fred",
1005                              -ExtraField => "Extra",
1006                              -Comment    => 'Comment';
1007     ok  $x->write($string) ;
1008     ok  $x->close ;
1009
1010     ok defined $buffer ;
1011
1012     ok my $got = Compress::Zlib::memGunzip($buffer)
1013         or diag "gzerrno is $gzerrno" ;
1014     is $got, $string ;
1015 }
1016
1017
1018 {
1019     # Trailer Corruption tests
1020
1021     my $string = <<EOM;
1022 some text
1023 EOM
1024
1025     my $good ;
1026     ok  my $x = new IO::Compress::Gzip \$good, Append => 1 ;
1027     ok  $x->write($string) ;
1028     ok  $x->close ;
1029
1030     foreach my $trim (-8 .. -1)
1031     {
1032         my $got = $trim + 8 ;
1033         title "Trailer Corruption - Trailer truncated to $got bytes" ;
1034         my $buffer = $good ;
1035
1036         substr($buffer, $trim) = '';
1037
1038         ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
1039         ok $u eq $string;
1040
1041     }
1042
1043     {
1044         title "Trailer Corruption - Length Wrong, CRC Correct" ;
1045         my $buffer = $good ;
1046         substr($buffer, -4, 4) = pack('V', 1234);
1047
1048         ok ! Compress::Zlib::memGunzip(\$buffer) ;
1049     }
1050
1051     {
1052         title "Trailer Corruption - Length Wrong, CRC Wrong" ;
1053         my $buffer = $good ;
1054         substr($buffer, -4, 4) = pack('V', 1234);
1055         substr($buffer, -8, 4) = pack('V', 1234);
1056
1057         ok ! Compress::Zlib::memGunzip(\$buffer) ;
1058
1059     }
1060 }
1061
1062
1063
1064