13 # use Test::NoWarnings, if available
16 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
27 plan tests => $count + $extra ;
29 use_ok('Compress::Zlib', 2) ;
30 use_ok('Compress::Gzip::Constants') ;
32 use_ok('IO::Compress::Gzip', qw($GzipError)) ;
41 my $len = length $hello ;
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" ;
47 # generate a long random string
50 { $contents .= chr int rand 256 }
55 # compress/uncompress tests
56 # =========================
58 eval { compress([1]); };
59 ok $@ =~ m#not a scalar reference#
62 eval { uncompress([1]); };
63 ok $@ =~ m#not a scalar reference#
66 $hello = "hello mum" ;
67 my $keep_hello = $hello ;
69 my $compr = compress($hello) ;
72 my $keep_compr = $compr ;
74 my $uncompr = uncompress ($compr) ;
76 ok $hello eq $uncompr ;
78 ok $hello eq $keep_hello ;
79 ok $compr eq $keep_compr ;
83 $keep_hello = $hello ;
85 $compr = compress($hello) ;
88 $keep_compr = $compr ;
90 $uncompr = uncompress ($compr) ;
92 ok $hello eq $uncompr ;
94 ok $hello eq $keep_hello ;
95 ok $compr eq $keep_compr ;
99 $compr = compress ($contents) ;
102 $uncompr = uncompress ($compr) ;
104 ok $contents eq $uncompr ;
108 $compr = compress(\$hello) ;
112 $uncompr = uncompress (\$compr) ;
113 ok $hello eq $uncompr ;
116 $compr = compress($hello, 1000) ;
120 $compr = compress($hello, Z_BEST_COMPRESSION) ;
122 $uncompr = uncompress (\$compr) ;
123 ok $hello eq $uncompr ;
126 $compr = compress(\$hello) ;
129 substr($compr,0, 1) = "\xFF";
130 ok !defined uncompress (\$compr) ;
132 # deflate/inflate - small buffer
133 # ==============================
135 $hello = "I am a HAL 9000 computer" ;
136 my @hello = split('', $hello) ;
137 my ($err, $X, $status);
139 ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
146 ($X, $status) = $x->deflate($_) ;
147 last unless $status == Z_OK ;
154 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
158 my @Answer = split('', $Answer) ;
161 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
169 ($Z, $status) = $k->inflate($_) ;
171 last if $status == Z_STREAM_END or $status != Z_OK ;
175 ok $status == Z_STREAM_END ;
179 title 'deflate/inflate - small buffer with a number';
180 # ==============================
184 ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
188 ok !defined $x->msg() ;
189 ok $x->total_in() == 0 ;
190 ok $x->total_out() == 0 ;
193 ($X, $status) = $x->deflate($hello) ;
200 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
203 ok !defined $x->msg() ;
204 ok $x->total_in() == length $hello ;
205 ok $x->total_out() == length $Answer ;
208 @Answer = split('', $Answer) ;
210 ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
214 ok !defined $k->msg() ;
215 ok $k->total_in() == 0 ;
216 ok $k->total_out() == 0 ;
221 ($Z, $status) = $k->inflate($_) ;
223 last if $status == Z_STREAM_END or $status != Z_OK ;
227 ok $status == Z_STREAM_END ;
230 ok !defined $k->msg() ;
231 is $k->total_in(), length $Answer ;
232 ok $k->total_out() == length $hello ;
236 title 'deflate/inflate - larger buffer';
237 # ==============================
240 ok $x = deflateInit() ;
242 ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
247 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
252 ok $k = inflateInit() ;
254 ($Z, $status) = $k->inflate($Y) ;
256 ok $status == Z_STREAM_END ;
259 title 'deflate/inflate - preset dictionary';
260 # ===================================
262 my $dictionary = "hello" ;
263 ok $x = deflateInit({-Level => Z_BEST_COMPRESSION,
264 -Dictionary => $dictionary}) ;
266 my $dictID = $x->dict_adler() ;
268 ($X, $status) = $x->deflate($hello) ;
270 ($Y, $status) = $x->flush() ;
275 ok $k = inflateInit(-Dictionary => $dictionary) ;
277 ($Z, $status) = $k->inflate($X);
278 ok $status == Z_STREAM_END ;
279 ok $k->dict_adler() == $dictID;
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";
288 #ok $status == Z_STREAM_END ;
290 # or print "status=[$status] hello=[$hello] Z=[$Z]\n";
297 title 'inflate - check remaining buffer after Z_STREAM_END';
298 # ===================================================
301 ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ;
303 ($X, $status) = $x->deflate($hello) ;
305 ($Y, $status) = $x->flush() ;
310 ok $k = inflateInit() ;
312 my $first = substr($X, 0, 2) ;
313 my $last = substr($X, 2) ;
314 ($Z, $status) = $k->inflate($first);
318 $last .= "appendage" ;
320 ($T, $status) = $k->inflate($last);
321 ok $status == Z_STREAM_END ;
322 ok $hello eq $Z . $T ;
323 ok $last eq "appendage" ;
327 title 'memGzip & memGunzip';
329 my $name = "test.gz" ;
336 my $len = length $buffer ;
340 # create an in-memory gzip file
341 my $dest = Compress::Zlib::memGzip($buffer) ;
345 ok open(FH, ">$name") ;
350 # uncompress with gzopen
351 ok my $fil = gzopen($name, "rb") ;
353 is $fil->gzread($uncomp, 0), 0 ;
354 ok (($x = $fil->gzread($uncomp)) == $len) ;
358 ok $uncomp eq $buffer ;
362 # now check that memGunzip can deal with it.
363 my $ungzip = Compress::Zlib::memGunzip($dest) ;
365 ok $buffer eq $ungzip ;
367 # now do the same but use a reference
369 $dest = Compress::Zlib::memGzip(\$buffer) ;
373 ok open(FH, ">$name") ;
378 # uncompress with gzopen
379 ok $fil = gzopen($name, "rb") ;
381 ok (($x = $fil->gzread($uncomp)) == $len) ;
385 ok $uncomp eq $buffer ;
387 # now check that memGunzip can deal with it.
389 $ungzip = Compress::Zlib::memGunzip(\$dest) ;
391 ok $buffer eq $ungzip ;
393 # check memGunzip can cope with missing gzip trailer
394 my $minimal = substr($keep, 0, -1) ;
395 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
397 ok $buffer eq $ungzip ;
399 $minimal = substr($keep, 0, -2) ;
400 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
402 ok $buffer eq $ungzip ;
404 $minimal = substr($keep, 0, -3) ;
405 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
407 ok $buffer eq $ungzip ;
409 $minimal = substr($keep, 0, -4) ;
410 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
412 ok $buffer eq $ungzip ;
414 $minimal = substr($keep, 0, -5) ;
415 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
417 ok $buffer eq $ungzip ;
419 $minimal = substr($keep, 0, -6) ;
420 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
422 ok $buffer eq $ungzip ;
424 $minimal = substr($keep, 0, -7) ;
425 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
427 ok $buffer eq $ungzip ;
429 $minimal = substr($keep, 0, -8) ;
430 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
432 ok $buffer eq $ungzip ;
434 $minimal = substr($keep, 0, -9) ;
435 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
436 ok ! defined $ungzip ;
441 # check corrupt header -- too short
443 my $result = Compress::Zlib::memGunzip($dest) ;
444 ok !defined $result ;
446 # check corrupt header -- full of junk
448 $result = Compress::Zlib::memGunzip($dest) ;
449 ok !defined $result ;
451 # corrupt header - 1st byte wrong
453 substr($bad, 0, 1) = "\xFF" ;
454 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
455 ok ! defined $ungzip ;
457 # corrupt header - 2st byte wrong
459 substr($bad, 1, 1) = "\xFF" ;
460 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
461 ok ! defined $ungzip ;
463 # corrupt header - method not deflated
465 substr($bad, 2, 1) = "\xFF" ;
466 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
467 ok ! defined $ungzip ;
469 # corrupt header - reserverd bits used
471 substr($bad, 3, 1) = "\xFF" ;
472 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
473 ok ! defined $ungzip ;
475 # corrupt trailer - length wrong
477 substr($bad, -8, 4) = "\xFF" x 4 ;
478 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
479 ok ! defined $ungzip ;
481 # corrupt trailer - CRC wrong
483 substr($bad, -4, 4) = "\xFF" x 4 ;
484 $ungzip = Compress::Zlib::memGunzip(\$bad) ;
485 ok ! defined $ungzip ;
488 title 'memGunzip with a gzopen created file';
490 my $name = "test.gz" ;
497 ok $fil = gzopen($name, "wb") ;
499 ok $fil->gzwrite($buffer) == length $buffer ;
503 my $compr = readFile($name);
505 my $unc = Compress::Zlib::memGunzip($compr) ;
516 $hello = "Test test test test test";
517 @hello = split('', $hello) ;
519 ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
526 ($X, $status) = $x->deflate($_) ;
527 last unless $status == Z_OK ;
534 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
538 @Answer = split('', $Answer) ;
539 # Undocumented corner -- extra byte needed to get inflate to return
540 # Z_STREAM_END when done.
543 ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
550 ($Z, $status) = $k->inflate($_) ;
552 last if $status == Z_STREAM_END or $status != Z_OK ;
556 ok $status == Z_STREAM_END ;
564 # create a deflate stream with flush points
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);
570 ok (($x, $err) = deflateInit() ) ;
574 ($Answer, $status) = $x->deflate($hello) ;
577 # create a flush point
578 ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
581 ($X, $status) = $x->deflate($goodbye) ;
585 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
588 my ($first, @Answer) = split('', $Answer) ;
591 ok (($k, $err) = inflateInit()) ;
595 ($Z, $status) = $k->inflate($first) ;
598 # skip to the first flush point.
601 my $byte = shift @Answer;
602 $status = $k->inflateSync($byte) ;
603 last unless $status == Z_DATA_ERROR;
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 ;
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 ;
626 # Check inflateSync leaves good data in buffer
627 $Answer =~ /^(.)(.*)$/ ;
628 my ($initial, $rest) = ($1, $2);
631 ok (($k, $err) = inflateInit()) ;
635 ($Z, $status) = $k->inflate($initial) ;
638 $status = $k->inflateSync($rest) ;
641 ($GOT, $status) = $k->inflate($rest) ;
643 ok $status == Z_DATA_ERROR ;
644 ok $Z . $GOT eq $goodbye ;
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);
654 ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION,
655 -Strategy => Z_DEFAULT_STRATEGY) ) ;
659 ok $x->get_Level() == Z_BEST_COMPRESSION;
660 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
662 ($Answer, $status) = $x->deflate($hello) ;
667 eval { $x->deflateParams() };
668 ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#;
670 eval { $x->deflateParams(-Joe => 3) };
671 ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
674 ok $x->get_Level() == Z_BEST_COMPRESSION;
675 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
677 # change both Level & Strategy
678 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
681 ok $x->get_Level() == Z_BEST_SPEED;
682 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
684 ($X, $status) = $x->deflate($goodbye) ;
690 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
693 ok $x->get_Level() == Z_NO_COMPRESSION;
694 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
696 ($X, $status) = $x->deflate($goodbye) ;
701 # change only Strategy
702 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
705 ok $x->get_Level() == Z_NO_COMPRESSION;
706 ok $x->get_Strategy() == Z_FILTERED;
708 ($X, $status) = $x->deflate($goodbye) ;
713 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
716 my ($first, @Answer) = split('', $Answer) ;
719 ok (($k, $err) = inflateInit()) ;
723 ($Z, $status) = $k->inflate($Answer) ;
725 ok $status == Z_STREAM_END
726 or print "# status $status\n";
733 eval { deflateInit(-Level) };
734 like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';
736 eval { inflateInit(-Level) };
737 like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';
739 eval { deflateInit(-Joe => 1) };
740 ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;
742 eval { inflateInit(-Joe => 1) };
743 ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;
745 eval { deflateInit(-Bufsize => 0) };
746 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
748 eval { inflateInit(-Bufsize => 0) };
749 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
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'/;
755 eval { inflateInit(-Bufsize => -1) };
756 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
758 eval { deflateInit(-Bufsize => "xxx") };
759 ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
761 eval { inflateInit(-Bufsize => "xxx") };
762 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
764 eval { gzopen([], 0) ; } ;
765 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
768 my $x = Symbol::gensym() ;
769 eval { gzopen($x, 0) ; } ;
770 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
777 # test inflate with a substr
779 ok my $x = deflateInit() ;
781 ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
787 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
790 my $append = "Appended" ;
793 ok $k = inflateInit() ;
795 #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
796 ($Z, $status) = $k->inflate(substr($Y, 0)) ;
798 ok $status == Z_STREAM_END ;
806 # deflate/inflate in scalar context
808 ok my $x = deflateInit() ;
810 my $X = $x->deflate($contents);
819 my $append = "Appended" ;
822 ok $k = inflateInit() ;
824 #$Z = $k->inflate(substr($Y, 0, -1)) ;
825 $Z = $k->inflate(substr($Y, 0)) ;
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;
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;
851 # memGunzip - input > 4K
855 { $contents .= chr int rand 256 }
857 ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
859 ok length $compressed > 4096 ;
860 ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
862 ok $contents eq $out ;
863 is length $out, length $contents ;
870 # memGunzip Header Corruption Tests
877 ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
878 ok $x->write($string) ;
882 title "Header Corruption - Fingerprint wrong 1st byte" ;
884 substr($buffer, 0, 1) = 'x' ;
886 ok ! Compress::Zlib::memGunzip(\$buffer) ;
890 title "Header Corruption - Fingerprint wrong 2nd byte" ;
892 substr($buffer, 1, 1) = "\xFF" ;
894 ok ! Compress::Zlib::memGunzip(\$buffer) ;
898 title "Header Corruption - CM not 8";
900 substr($buffer, 2, 1) = 'x' ;
902 ok ! Compress::Zlib::memGunzip(\$buffer) ;
906 title "Header Corruption - Use of Reserved Flags";
908 substr($buffer, 3, 1) = "\xff";
910 ok ! Compress::Zlib::memGunzip(\$buffer) ;
915 for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
917 title "Header Corruption - Truncated in Extra";
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) ;
928 substr($truncated, $index) = '' ;
930 ok ! Compress::Zlib::memGunzip(\$truncated) ;
936 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1)
938 title "Header Corruption - Truncated in Name";
944 ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
945 ok $x->write($string) ;
948 substr($truncated, $index) = '' ;
950 ok ! Compress::Zlib::memGunzip(\$truncated) ;
953 my $Comment = "comment" ;
954 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1)
956 title "Header Corruption - Truncated in Comment";
962 ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
963 ok $x->write($string) ;
966 substr($truncated, $index) = '' ;
967 ok ! Compress::Zlib::memGunzip(\$truncated) ;
970 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
972 title "Header Corruption - Truncated in CRC";
978 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
979 ok $x->write($string) ;
982 substr($truncated, $index) = '' ;
984 ok ! Compress::Zlib::memGunzip(\$truncated) ;
988 title "memGunzip can cope with a gzip header with all possible fields";
994 ok my $x = new IO::Compress::Gzip \$buffer,
999 -ExtraField => "Extra",
1000 -Comment => 'Comment';
1001 ok $x->write($string) ;
1004 ok defined $buffer ;
1006 ok my $got = Compress::Zlib::memGunzip($buffer)
1007 or diag "gzerrno is $gzerrno" ;
1013 # Trailer Corruption tests
1020 ok my $x = new IO::Compress::Gzip \$good, Append => 1 ;
1021 ok $x->write($string) ;
1024 foreach my $trim (-8 .. -1)
1026 my $got = $trim + 8 ;
1027 title "Trailer Corruption - Trailer truncated to $got bytes" ;
1028 my $buffer = $good ;
1030 substr($buffer, $trim) = '';
1032 ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
1038 title "Trailer Corruption - Length Wrong, CRC Correct" ;
1039 my $buffer = $good ;
1040 substr($buffer, -4, 4) = pack('V', 1234);
1042 ok ! Compress::Zlib::memGunzip(\$buffer) ;
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);
1051 ok ! Compress::Zlib::memGunzip(\$buffer) ;