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

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