19 # use Test::NoWarnings, if available
22 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
33 plan tests => $count + $extra ;
35 use_ok('Compress::Zlib', 2) ;
36 use_ok('Compress::Gzip::Constants') ;
38 use_ok('IO::Compress::Gzip', qw($GzipError)) ;
47 my $len = length $hello ;
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" ;
53 # generate a long random string
56 { $contents .= chr int rand 256 }
61 # compress/uncompress tests
62 # =========================
64 eval { compress([1]); };
65 ok $@ =~ m#not a scalar reference#
68 eval { uncompress([1]); };
69 ok $@ =~ m#not a scalar reference#
72 $hello = "hello mum" ;
73 my $keep_hello = $hello ;
75 my $compr = compress($hello) ;
78 my $keep_compr = $compr ;
80 my $uncompr = uncompress ($compr) ;
82 ok $hello eq $uncompr ;
84 ok $hello eq $keep_hello ;
85 ok $compr eq $keep_compr ;
89 $keep_hello = $hello ;
91 $compr = compress($hello) ;
94 $keep_compr = $compr ;
96 $uncompr = uncompress ($compr) ;
98 ok $hello eq $uncompr ;
100 ok $hello eq $keep_hello ;
101 ok $compr eq $keep_compr ;
105 $compr = compress ($contents) ;
108 $uncompr = uncompress ($compr) ;
110 ok $contents eq $uncompr ;
114 $compr = compress(\$hello) ;
118 $uncompr = uncompress (\$compr) ;
119 ok $hello eq $uncompr ;
122 $compr = compress($hello, 1000) ;
126 $compr = compress($hello, Z_BEST_COMPRESSION) ;
128 $uncompr = uncompress (\$compr) ;
129 ok $hello eq $uncompr ;
132 $compr = compress(\$hello) ;
135 substr($compr,0, 1) = "\xFF";
136 ok !defined uncompress (\$compr) ;
138 # deflate/inflate - small buffer
139 # ==============================
141 $hello = "I am a HAL 9000 computer" ;
142 my @hello = split('', $hello) ;
143 my ($err, $X, $status);
145 ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
152 ($X, $status) = $x->deflate($_) ;
153 last unless $status == Z_OK ;
160 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
164 my @Answer = split('', $Answer) ;
167 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
175 ($Z, $status) = $k->inflate($_) ;
177 last if $status == Z_STREAM_END or $status != Z_OK ;
181 ok $status == Z_STREAM_END ;
185 title 'deflate/inflate - small buffer with a number';
186 # ==============================
190 ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
194 ok !defined $x->msg() ;
195 ok $x->total_in() == 0 ;
196 ok $x->total_out() == 0 ;
199 ($X, $status) = $x->deflate($hello) ;
206 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
209 ok !defined $x->msg() ;
210 ok $x->total_in() == length $hello ;
211 ok $x->total_out() == length $Answer ;
214 @Answer = split('', $Answer) ;
216 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
220 ok !defined $k->msg() ;
221 ok $k->total_in() == 0 ;
222 ok $k->total_out() == 0 ;
227 ($Z, $status) = $k->inflate($_) ;
229 last if $status == Z_STREAM_END or $status != Z_OK ;
233 ok $status == Z_STREAM_END ;
236 ok !defined $k->msg() ;
237 is $k->total_in(), length $Answer ;
238 ok $k->total_out() == length $hello ;
242 title 'deflate/inflate - larger buffer';
243 # ==============================
246 ok $x = deflateInit() ;
248 ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
253 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
258 ok $k = inflateInit() ;
260 ($Z, $status) = $k->inflate($Y) ;
262 ok $status == Z_STREAM_END ;
265 title 'deflate/inflate - preset dictionary';
266 # ===================================
268 my $dictionary = "hello" ;
269 ok $x = deflateInit({-Level => Z_BEST_COMPRESSION,
270 -Dictionary => $dictionary}) ;
272 my $dictID = $x->dict_adler() ;
274 ($X, $status) = $x->deflate($hello) ;
276 ($Y, $status) = $x->flush() ;
281 ok $k = inflateInit(-Dictionary => $dictionary) ;
283 ($Z, $status) = $k->inflate($X);
284 ok $status == Z_STREAM_END ;
285 ok $k->dict_adler() == $dictID;
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";
294 #ok $status == Z_STREAM_END ;
296 # or print "status=[$status] hello=[$hello] Z=[$Z]\n";
303 title 'inflate - check remaining buffer after Z_STREAM_END';
304 # ===================================================
307 ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ;
309 ($X, $status) = $x->deflate($hello) ;
311 ($Y, $status) = $x->flush() ;
316 ok $k = inflateInit() ;
318 my $first = substr($X, 0, 2) ;
319 my $last = substr($X, 2) ;
320 ($Z, $status) = $k->inflate($first);
324 $last .= "appendage" ;
326 ($T, $status) = $k->inflate($last);
327 ok $status == Z_STREAM_END ;
328 ok $hello eq $Z . $T ;
329 ok $last eq "appendage" ;
333 title 'memGzip & memGunzip';
335 my $name = "test.gz" ;
342 my $len = length $buffer ;
346 # create an in-memory gzip file
347 my $dest = Compress::Zlib::memGzip($buffer) ;
351 ok open(FH, ">$name") ;
356 # uncompress with gzopen
357 ok my $fil = gzopen($name, "rb") ;
359 is $fil->gzread($uncomp, 0), 0 ;
360 ok (($x = $fil->gzread($uncomp)) == $len) ;
364 ok $uncomp eq $buffer ;
368 # now check that memGunzip can deal with it.
369 my $ungzip = Compress::Zlib::memGunzip($dest) ;
371 ok $buffer eq $ungzip ;
373 # now do the same but use a reference
375 $dest = Compress::Zlib::memGzip(\$buffer) ;
379 ok open(FH, ">$name") ;
384 # uncompress with gzopen
385 ok $fil = gzopen($name, "rb") ;
387 ok (($x = $fil->gzread($uncomp)) == $len) ;
391 ok $uncomp eq $buffer ;
393 # now check that memGunzip can deal with it.
395 $ungzip = Compress::Zlib::memGunzip(\$dest) ;
397 ok $buffer eq $ungzip ;
399 # check memGunzip can cope with missing gzip trailer
400 my $minimal = substr($keep, 0, -1) ;
401 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
403 ok $buffer eq $ungzip ;
405 $minimal = substr($keep, 0, -2) ;
406 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
408 ok $buffer eq $ungzip ;
410 $minimal = substr($keep, 0, -3) ;
411 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
413 ok $buffer eq $ungzip ;
415 $minimal = substr($keep, 0, -4) ;
416 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
418 ok $buffer eq $ungzip ;
420 $minimal = substr($keep, 0, -5) ;
421 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
423 ok $buffer eq $ungzip ;
425 $minimal = substr($keep, 0, -6) ;
426 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
428 ok $buffer eq $ungzip ;
430 $minimal = substr($keep, 0, -7) ;
431 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
433 ok $buffer eq $ungzip ;
435 $minimal = substr($keep, 0, -8) ;
436 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
438 ok $buffer eq $ungzip ;
440 $minimal = substr($keep, 0, -9) ;
441 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
442 ok ! defined $ungzip ;
447 # check corrupt header -- too short
449 my $result = Compress::Zlib::memGunzip($dest) ;
450 ok !defined $result ;
452 # check corrupt header -- full of junk
454 $result = Compress::Zlib::memGunzip($dest) ;
455 ok !defined $result ;
457 # corrupt header - 1st byte wrong
459 substr($bad, 0, 1) = "\xFF" ;
460 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
461 ok ! defined $ungzip ;
463 # corrupt header - 2st byte wrong
465 substr($bad, 1, 1) = "\xFF" ;
466 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
467 ok ! defined $ungzip ;
469 # corrupt header - method not deflated
471 substr($bad, 2, 1) = "\xFF" ;
472 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
473 ok ! defined $ungzip ;
475 # corrupt header - reserverd bits used
477 substr($bad, 3, 1) = "\xFF" ;
478 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
479 ok ! defined $ungzip ;
481 # corrupt trailer - length wrong
483 substr($bad, -8, 4) = "\xFF" x 4 ;
484 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
485 ok ! defined $ungzip ;
487 # corrupt trailer - CRC wrong
489 substr($bad, -4, 4) = "\xFF" x 4 ;
490 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
491 ok ! defined $ungzip ;
494 title 'memGunzip with a gzopen created file';
496 my $name = "test.gz" ;
503 ok $fil = gzopen($name, "wb") ;
505 ok $fil->gzwrite($buffer) == length $buffer ;
509 my $compr = readFile($name);
511 my $unc = Compress::Zlib::memGunzip($compr) ;
522 $hello = "Test test test test test";
523 @hello = split('', $hello) ;
525 ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
532 ($X, $status) = $x->deflate($_) ;
533 last unless $status == Z_OK ;
540 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
544 @Answer = split('', $Answer) ;
545 # Undocumented corner -- extra byte needed to get inflate to return
546 # Z_STREAM_END when done.
549 ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
556 ($Z, $status) = $k->inflate($_) ;
558 last if $status == Z_STREAM_END or $status != Z_OK ;
562 ok $status == Z_STREAM_END ;
570 # create a deflate stream with flush points
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);
576 ok (($x, $err) = deflateInit() ) ;
580 ($Answer, $status) = $x->deflate($hello) ;
583 # create a flush point
584 ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
587 ($X, $status) = $x->deflate($goodbye) ;
591 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
594 my ($first, @Answer) = split('', $Answer) ;
597 ok (($k, $err) = inflateInit()) ;
601 ($Z, $status) = $k->inflate($first) ;
604 # skip to the first flush point.
607 my $byte = shift @Answer;
608 $status = $k->inflateSync($byte) ;
609 last unless $status == Z_DATA_ERROR;
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 ;
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 ;
632 # Check inflateSync leaves good data in buffer
633 $Answer =~ /^(.)(.*)$/ ;
634 my ($initial, $rest) = ($1, $2);
637 ok (($k, $err) = inflateInit()) ;
641 ($Z, $status) = $k->inflate($initial) ;
644 $status = $k->inflateSync($rest) ;
647 ($GOT, $status) = $k->inflate($rest) ;
649 ok $status == Z_DATA_ERROR ;
650 ok $Z . $GOT eq $goodbye ;
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);
660 ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION,
661 -Strategy => Z_DEFAULT_STRATEGY) ) ;
665 ok $x->get_Level() == Z_BEST_COMPRESSION;
666 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
668 ($Answer, $status) = $x->deflate($hello) ;
673 eval { $x->deflateParams() };
674 ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#;
676 eval { $x->deflateParams(-Joe => 3) };
677 ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
680 ok $x->get_Level() == Z_BEST_COMPRESSION;
681 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
683 # change both Level & Strategy
684 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
687 ok $x->get_Level() == Z_BEST_SPEED;
688 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
690 ($X, $status) = $x->deflate($goodbye) ;
696 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
699 ok $x->get_Level() == Z_NO_COMPRESSION;
700 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
702 ($X, $status) = $x->deflate($goodbye) ;
707 # change only Strategy
708 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
711 ok $x->get_Level() == Z_NO_COMPRESSION;
712 ok $x->get_Strategy() == Z_FILTERED;
714 ($X, $status) = $x->deflate($goodbye) ;
719 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
722 my ($first, @Answer) = split('', $Answer) ;
725 ok (($k, $err) = inflateInit()) ;
729 ($Z, $status) = $k->inflate($Answer) ;
731 ok $status == Z_STREAM_END
732 or print "# status $status\n";
739 eval { deflateInit(-Level) };
740 like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';
742 eval { inflateInit(-Level) };
743 like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';
745 eval { deflateInit(-Joe => 1) };
746 ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;
748 eval { inflateInit(-Joe => 1) };
749 ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;
751 eval { deflateInit(-Bufsize => 0) };
752 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
754 eval { inflateInit(-Bufsize => 0) };
755 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
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'/;
761 eval { inflateInit(-Bufsize => -1) };
762 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
764 eval { deflateInit(-Bufsize => "xxx") };
765 ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
767 eval { inflateInit(-Bufsize => "xxx") };
768 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
770 eval { gzopen([], 0) ; } ;
771 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
774 my $x = Symbol::gensym() ;
775 eval { gzopen($x, 0) ; } ;
776 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
783 # test inflate with a substr
785 ok my $x = deflateInit() ;
787 ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
793 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
796 my $append = "Appended" ;
799 ok $k = inflateInit() ;
801 #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
802 ($Z, $status) = $k->inflate(substr($Y, 0)) ;
804 ok $status == Z_STREAM_END ;
812 # deflate/inflate in scalar context
814 ok my $x = deflateInit() ;
816 my $X = $x->deflate($contents);
825 my $append = "Appended" ;
828 ok $k = inflateInit() ;
830 #$Z = $k->inflate(substr($Y, 0, -1)) ;
831 $Z = $k->inflate(substr($Y, 0)) ;
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;
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;
857 # memGunzip - input > 4K
861 { $contents .= chr int rand 256 }
863 ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
865 ok length $compressed > 4096 ;
866 ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
868 ok $contents eq $out ;
869 is length $out, length $contents ;
876 # memGunzip Header Corruption Tests
883 ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
884 ok $x->write($string) ;
888 title "Header Corruption - Fingerprint wrong 1st byte" ;
890 substr($buffer, 0, 1) = 'x' ;
892 ok ! Compress::Zlib::memGunzip(\$buffer) ;
896 title "Header Corruption - Fingerprint wrong 2nd byte" ;
898 substr($buffer, 1, 1) = "\xFF" ;
900 ok ! Compress::Zlib::memGunzip(\$buffer) ;
904 title "Header Corruption - CM not 8";
906 substr($buffer, 2, 1) = 'x' ;
908 ok ! Compress::Zlib::memGunzip(\$buffer) ;
912 title "Header Corruption - Use of Reserved Flags";
914 substr($buffer, 3, 1) = "\xff";
916 ok ! Compress::Zlib::memGunzip(\$buffer) ;
921 for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
923 title "Header Corruption - Truncated in Extra";
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) ;
934 substr($truncated, $index) = '' ;
936 ok ! Compress::Zlib::memGunzip(\$truncated) ;
942 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1)
944 title "Header Corruption - Truncated in Name";
950 ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
951 ok $x->write($string) ;
954 substr($truncated, $index) = '' ;
956 ok ! Compress::Zlib::memGunzip(\$truncated) ;
959 my $Comment = "comment" ;
960 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1)
962 title "Header Corruption - Truncated in Comment";
968 ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
969 ok $x->write($string) ;
972 substr($truncated, $index) = '' ;
973 ok ! Compress::Zlib::memGunzip(\$truncated) ;
976 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
978 title "Header Corruption - Truncated in CRC";
984 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
985 ok $x->write($string) ;
988 substr($truncated, $index) = '' ;
990 ok ! Compress::Zlib::memGunzip(\$truncated) ;
994 title "memGunzip can cope with a gzip header with all possible fields";
1000 ok my $x = new IO::Compress::Gzip \$buffer,
1005 -ExtraField => "Extra",
1006 -Comment => 'Comment';
1007 ok $x->write($string) ;
1010 ok defined $buffer ;
1012 ok my $got = Compress::Zlib::memGunzip($buffer)
1013 or diag "gzerrno is $gzerrno" ;
1019 # Trailer Corruption tests
1026 ok my $x = new IO::Compress::Gzip \$good, Append => 1 ;
1027 ok $x->write($string) ;
1030 foreach my $trim (-8 .. -1)
1032 my $got = $trim + 8 ;
1033 title "Trailer Corruption - Trailer truncated to $got bytes" ;
1034 my $buffer = $good ;
1036 substr($buffer, $trim) = '';
1038 ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
1044 title "Trailer Corruption - Length Wrong, CRC Correct" ;
1045 my $buffer = $good ;
1046 substr($buffer, -4, 4) = pack('V', 1234);
1048 ok ! Compress::Zlib::memGunzip(\$buffer) ;
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);
1057 ok ! Compress::Zlib::memGunzip(\$buffer) ;