4 local ($^W) = 1; #use warnings ;
13 #++ $totalBad unless $ok ;
15 print "ok $no\n" if $ok ;
16 print "not ok $no\n" unless $ok ;
24 open (F, "<$filename")
25 or die "Cannot open $filename: $!\n" ;
38 my $len = length $hello ;
43 # Check zlib_version and ZLIB_VERSION are the same.
44 ok(1, Compress::Zlib::zlib_version eq ZLIB_VERSION) ;
49 my $name = "test.gz" ;
52 ok(2, my $fil = gzopen($name, "wb")) ;
56 ok(4, $fil->gzwrite($hello) == $len) ;
58 ok(5, ! $fil->gzclose ) ;
60 ok(6, $fil = gzopen($name, "rb") ) ;
64 ok(8, ($x = $fil->gzread($uncomp)) == $len) ;
66 ok(9, ! $fil->gzclose ) ;
70 ok(10, $hello eq $uncomp) ;
72 # check that a number can be gzipped
76 ok(11, $fil = gzopen($name, "wb")) ;
78 ok(12, $gzerrno == 0);
80 ok(13, $fil->gzwrite($number) == $num_len) ;
82 ok(14, $gzerrno == 0);
84 ok(15, ! $fil->gzclose ) ;
86 ok(16, $gzerrno == 0);
88 ok(17, $fil = gzopen($name, "rb") ) ;
90 ok(18, ($x = $fil->gzread($uncomp)) == $num_len) ;
92 ok(19, $gzerrno == 0 || $gzerrno == Z_STREAM_END);
94 ok(20, ! $fil->gzclose ) ;
96 ok(21, $gzerrno == 0);
100 ok(22, $number == $uncomp) ;
101 ok(23, $number eq $uncomp) ;
104 # now a bigger gzip test
107 my $file = "$text.gz" ;
109 ok(24, my $f = gzopen($file, "wb")) ;
111 # generate a long random string
114 { $contents .= chr int rand 256 }
116 $len = length $contents ;
118 ok(25, $f->gzwrite($contents) == $len ) ;
120 ok(26, ! $f->gzclose );
122 ok(27, $f = gzopen($file, "rb")) ;
125 ok(28, $f->gzread($uncompressed, $len) == $len) ;
127 ok(29, $contents eq $uncompressed) ;
129 ok(30, ! $f->gzclose ) ;
133 # gzip - readline tests
134 # ======================
136 # first create a small gzipped text file
138 my @text = (<<EOM, <<EOM, <<EOM, <<EOM) ;
143 the line after the previous line
148 $text = join("", @text) ;
150 ok(31, $fil = gzopen($name, "wb")) ;
151 ok(32, $fil->gzwrite($text) == length $text) ;
152 ok(33, ! $fil->gzclose ) ;
154 # now try to read it back in
155 ok(34, $fil = gzopen($name, "rb")) ;
160 while ($fil->gzreadline($line) > 0) {
162 if $line ne $text[$lines] ;
167 ok(36, $remember eq $text) ;
168 ok(37, $lines == @text) ;
169 ok(38, ! $fil->gzclose ) ;
172 # a text file with a very long line (bigger than the internal buffer)
173 my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ;
174 my $line2 = "second line\n" ;
175 $text = $line1 . $line2 ;
176 ok(39, $fil = gzopen($name, "wb")) ;
177 ok(40, $fil->gzwrite($text) == length $text) ;
178 ok(41, ! $fil->gzclose ) ;
180 # now try to read it back in
181 ok(42, $fil = gzopen($name, "rb")) ;
184 while ($fil->gzreadline($line) > 0) {
189 ok(44, $got[0] eq $line1 ) ;
190 ok(45, $got[1] eq $line2) ;
192 ok(46, ! $fil->gzclose ) ;
196 # a text file which is not termined by an EOL
198 $line1 = "hello hello, I'm back again\n" ;
199 $line2 = "there is no end in sight" ;
201 $text = $line1 . $line2 ;
202 ok(47, $fil = gzopen($name, "wb")) ;
203 ok(48, $fil->gzwrite($text) == length $text) ;
204 ok(49, ! $fil->gzclose ) ;
206 # now try to read it back in
207 ok(50, $fil = gzopen($name, "rb")) ;
209 while ($fil->gzreadline($line) > 0) {
214 ok(52, $got[0] eq $line1 ) ;
215 ok(53, $got[1] eq $line2) ;
217 ok(54, ! $fil->gzclose ) ;
222 # mix gzread and gzreadline <
224 # case 1: read a line, then a block. The block is
225 # smaller than the internal block used by
227 $line1 = "hello hello, I'm back again\n" ;
228 $line2 = "abc" x 200 ;
229 my $line3 = "def" x 200 ;
231 $text = $line1 . $line2 . $line3 ;
232 ok(55, $fil = gzopen($name, "wb")) ;
233 ok(56, $fil->gzwrite($text) == length $text) ;
234 ok(57, ! $fil->gzclose ) ;
236 # now try to read it back in
237 ok(58, $fil = gzopen($name, "rb")) ;
238 ok(59, $fil->gzreadline($line) > 0) ;
239 ok(60, $line eq $line1) ;
240 ok(61, $fil->gzread($line, length $line2) > 0) ;
241 ok(62, $line eq $line2) ;
242 ok(63, $fil->gzread($line, length $line3) > 0) ;
243 ok(64, $line eq $line3) ;
244 ok(65, ! $fil->gzclose ) ;
251 # compress/uncompress tests
252 # =========================
254 $hello = "hello mum" ;
255 my $keep_hello = $hello ;
257 my $compr = compress($hello) ;
258 ok(66, $compr ne "") ;
260 my $keep_compr = $compr ;
262 my $uncompr = uncompress ($compr) ;
264 ok(67, $hello eq $uncompr) ;
266 ok(68, $hello eq $keep_hello) ;
267 ok(69, $compr eq $keep_compr) ;
271 $keep_hello = $hello ;
273 $compr = compress($hello) ;
274 ok(70, $compr ne "") ;
276 $keep_compr = $compr ;
278 $uncompr = uncompress ($compr) ;
280 ok(71, $hello eq $uncompr) ;
282 ok(72, $hello eq $keep_hello) ;
283 ok(73, $compr eq $keep_compr) ;
287 $compr = compress ($contents) ;
288 ok(74, $compr ne "") ;
290 $uncompr = uncompress ($compr) ;
292 ok(75, $contents eq $uncompr) ;
296 $compr = compress(\$hello) ;
297 ok(76, $compr ne "") ;
300 $uncompr = uncompress (\$compr) ;
301 ok(77, $hello eq $uncompr) ;
304 $compr = compress($hello, 1000) ;
305 ok(78, ! defined $compr);
308 $compr = compress($hello, Z_BEST_COMPRESSION) ;
309 ok(79, defined $compr);
310 $uncompr = uncompress (\$compr) ;
311 ok(80, $hello eq $uncompr) ;
313 # deflate/inflate - small buffer
314 # ==============================
316 $hello = "I am a HAL 9000 computer" ;
317 my @hello = split('', $hello) ;
318 my ($err, $X, $status);
320 ok(81, ($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
322 ok(83, $err == Z_OK) ;
327 ($X, $status) = $x->deflate($_) ;
328 last unless $status == Z_OK ;
333 ok(84, $status == Z_OK) ;
335 ok(85, (($X, $status) = $x->flush())[1] == Z_OK ) ;
339 my @Answer = split('', $Answer) ;
342 ok(86, ($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
344 ok(88, $err == Z_OK) ;
350 ($Z, $status) = $k->inflate($_) ;
352 last if $status == Z_STREAM_END or $status != Z_OK ;
356 ok(89, $status == Z_STREAM_END) ;
357 ok(90, $GOT eq $hello ) ;
360 # deflate/inflate - small buffer with a number
361 # ==============================
365 ok(91, ($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
367 ok(93, $err == Z_OK) ;
371 ($X, $status) = $x->deflate($hello) ;
376 ok(94, $status == Z_OK) ;
378 ok(95, (($X, $status) = $x->flush())[1] == Z_OK ) ;
382 @Answer = split('', $Answer) ;
384 ok(96, ($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
386 ok(98, $err == Z_OK) ;
391 ($Z, $status) = $k->inflate($_) ;
393 last if $status == Z_STREAM_END or $status != Z_OK ;
397 ok(99, $status == Z_STREAM_END) ;
398 ok(100, $GOT eq $hello ) ;
402 # deflate/inflate - larger buffer
403 # ==============================
406 ok(101, $x = deflateInit() ) ;
408 ok(102, (($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
413 ok(103, (($X, $status) = $x->flush() )[1] == Z_OK ) ;
418 ok(104, $k = inflateInit() ) ;
420 ($Z, $status) = $k->inflate($Y) ;
422 ok(105, $status == Z_STREAM_END) ;
423 ok(106, $contents eq $Z ) ;
425 # deflate/inflate - preset dictionary
426 # ===================================
428 my $dictionary = "hello" ;
429 ok(107, $x = deflateInit({-Level => Z_BEST_COMPRESSION,
430 -Dictionary => $dictionary})) ;
432 my $dictID = $x->dict_adler() ;
434 ($X, $status) = $x->deflate($hello) ;
435 ok(108, $status == Z_OK) ;
436 ($Y, $status) = $x->flush() ;
437 ok(109, $status == Z_OK) ;
441 ok(110, $k = inflateInit(-Dictionary => $dictionary) ) ;
443 ($Z, $status) = $k->inflate($X);
444 ok(111, $status == Z_STREAM_END) ;
445 ok(112, $k->dict_adler() == $dictID);
446 ok(113, $hello eq $Z ) ;
448 ##ok(76, $k->inflateSetDictionary($dictionary) == Z_OK);
452 # ($Z, $status) = $k->inflate($X) ;
453 # last if $status == Z_STREAM_END or $status != Z_OK ;
454 #print "status=[$status] hello=[$hello] Z=[$Z]\n";
456 #ok(77, $status == Z_STREAM_END) ;
457 #ok(78, $hello eq $Z ) ;
458 #print "status=[$status] hello=[$hello] Z=[$Z]\n";
467 # inflate - check remaining buffer after Z_STREAM_END
468 # ===================================================
471 ok(114, $x = deflateInit(-Level => Z_BEST_COMPRESSION )) ;
473 ($X, $status) = $x->deflate($hello) ;
474 ok(115, $status == Z_OK) ;
475 ($Y, $status) = $x->flush() ;
476 ok(116, $status == Z_OK) ;
480 ok(117, $k = inflateInit() ) ;
482 my $first = substr($X, 0, 2) ;
483 my $last = substr($X, 2) ;
484 ($Z, $status) = $k->inflate($first);
485 ok(118, $status == Z_OK) ;
486 ok(119, $first eq "") ;
488 $last .= "appendage" ;
489 my ($T, $status) = $k->inflate($last);
490 ok(120, $status == Z_STREAM_END) ;
491 ok(121, $hello eq $Z . $T ) ;
492 ok(122, $last eq "appendage") ;
496 # memGzip & memGunzip
498 my $name = "test.gz" ;
505 my $len = length $buffer ;
509 # create an in-memory gzip file
510 my $dest = Compress::Zlib::memGzip($buffer) ;
511 ok(123, length $dest) ;
514 ok(124, open(FH, ">$name")) ;
519 # uncompress with gzopen
520 ok(125, my $fil = gzopen($name, "rb") ) ;
522 ok(126, ($x = $fil->gzread($uncomp)) == $len) ;
524 ok(127, ! $fil->gzclose ) ;
526 ok(128, $uncomp eq $buffer) ;
530 # now check that memGunzip can deal with it.
531 my $ungzip = Compress::Zlib::memGunzip($dest) ;
532 ok(129, defined $ungzip) ;
533 ok(130, $buffer eq $ungzip) ;
535 # now do the same but use a reference
537 $dest = Compress::Zlib::memGzip(\$buffer) ;
538 ok(131, length $dest) ;
541 ok(132, open(FH, ">$name")) ;
546 # uncompress with gzopen
547 ok(133, $fil = gzopen($name, "rb") ) ;
549 ok(134, ($x = $fil->gzread($uncomp)) == $len) ;
551 ok(135, ! $fil->gzclose ) ;
553 ok(136, $uncomp eq $buffer) ;
555 # now check that memGunzip can deal with it.
557 $ungzip = Compress::Zlib::memGunzip(\$dest) ;
558 ok(137, defined $ungzip) ;
559 ok(138, $buffer eq $ungzip) ;
561 # check memGunzip can cope with missing gzip trailer
562 my $minimal = substr($keep, 0, -1) ;
563 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
564 ok(139, defined $ungzip) ;
565 ok(140, $buffer eq $ungzip) ;
567 $minimal = substr($keep, 0, -2) ;
568 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
569 ok(141, defined $ungzip) ;
570 ok(142, $buffer eq $ungzip) ;
572 $minimal = substr($keep, 0, -3) ;
573 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
574 ok(143, defined $ungzip) ;
575 ok(144, $buffer eq $ungzip) ;
577 $minimal = substr($keep, 0, -4) ;
578 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
579 ok(145, defined $ungzip) ;
580 ok(146, $buffer eq $ungzip) ;
582 $minimal = substr($keep, 0, -5) ;
583 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
584 ok(147, defined $ungzip) ;
585 ok(148, $buffer eq $ungzip) ;
587 $minimal = substr($keep, 0, -6) ;
588 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
589 ok(149, defined $ungzip) ;
590 ok(150, $buffer eq $ungzip) ;
592 $minimal = substr($keep, 0, -7) ;
593 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
594 ok(151, defined $ungzip) ;
595 ok(152, $buffer eq $ungzip) ;
597 $minimal = substr($keep, 0, -8) ;
598 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
599 ok(153, defined $ungzip) ;
600 ok(154, $buffer eq $ungzip) ;
602 $minimal = substr($keep, 0, -9) ;
603 $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
604 ok(155, ! defined $ungzip) ;
609 # check corrupt header -- too short
611 my $result = Compress::Zlib::memGunzip($dest) ;
612 ok(156, !defined $result) ;
614 # check corrupt header -- full of junk
616 $result = Compress::Zlib::memGunzip($dest) ;
617 ok(157, !defined $result) ;
620 # memGunzip with a gzopen created file
622 my $name = "test.gz" ;
629 ok(158, $fil = gzopen($name, "wb")) ;
631 ok(159, $fil->gzwrite($buffer) == length $buffer) ;
633 ok(160, ! $fil->gzclose ) ;
635 my $compr = readFile($name);
636 ok(161, length $compr) ;
637 my $unc = Compress::Zlib::memGunzip($compr) ;
638 ok(162, defined $unc) ;
639 ok(163, $buffer eq $unc) ;
648 $hello = "Test test test test test";
649 @hello = split('', $hello) ;
651 ok(164, ($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
653 ok(166, $err == Z_OK) ;
658 ($X, $status) = $x->deflate($_) ;
659 last unless $status == Z_OK ;
664 ok(167, $status == Z_OK) ;
666 ok(168, (($X, $status) = $x->flush())[1] == Z_OK ) ;
670 @Answer = split('', $Answer) ;
671 # Undocumented corner -- extra byte needed to get inflate to return
672 # Z_STREAM_END when done.
675 ok(169, ($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
677 ok(171, $err == Z_OK) ;
682 ($Z, $status) = $k->inflate($_) ;
684 last if $status == Z_STREAM_END or $status != Z_OK ;
688 ok(172, $status == Z_STREAM_END) ;
689 ok(173, $GOT eq $hello ) ;
696 # create a deflate stream with flush points
698 my $hello = "I am a HAL 9000 computer" x 2001 ;
699 my $goodbye = "Will I dream?" x 2010;
700 my ($err, $answer, $X, $status, $Answer);
702 ok(174, ($x, $err) = deflateInit() ) ;
704 ok(176, $err == Z_OK) ;
706 ($Answer, $status) = $x->deflate($hello) ;
707 ok(177, $status == Z_OK) ;
709 # create a flush point
710 ok(178, (($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
713 ($X, $status) = $x->deflate($goodbye) ;
714 ok(179, $status == Z_OK) ;
717 ok(180, (($X, $status) = $x->flush())[1] == Z_OK ) ;
720 my ($first, @Answer) = split('', $Answer) ;
723 ok(181, ($k, $err) = inflateInit()) ;
725 ok(183, $err == Z_OK) ;
727 ($Z, $status) = $k->inflate($first) ;
728 ok(184, $status == Z_OK) ;
730 # skip to the first flush point.
733 my $byte = shift @Answer;
734 $status = $k->inflateSync($byte) ;
735 last unless $status == Z_DATA_ERROR;
739 ok(185, $status == Z_OK);
746 ($Z, $status) = $k->inflate($_) ;
747 $GOT .= $Z if defined $Z ;
748 # print "x $status\n";
749 last if $status == Z_STREAM_END or $status != Z_OK ;
753 # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR
754 ok(186, $status == Z_DATA_ERROR || $status == Z_STREAM_END) ;
755 ok(187, $GOT eq $goodbye ) ;
758 # Check inflateSync leaves good data in buffer
759 $Answer =~ /^(.)(.*)$/ ;
760 my ($initial, $rest) = ($1, $2);
763 ok(188, ($k, $err) = inflateInit()) ;
765 ok(190, $err == Z_OK) ;
767 ($Z, $status) = $k->inflate($initial) ;
768 ok(191, $status == Z_OK) ;
770 $status = $k->inflateSync($rest) ;
771 ok(192, $status == Z_OK);
773 ($GOT, $status) = $k->inflate($rest) ;
775 ok(193, $status == Z_DATA_ERROR) ;
776 ok(194, $Z . $GOT eq $goodbye ) ;
782 my $hello = "I am a HAL 9000 computer" x 2001 ;
783 my $goodbye = "Will I dream?" x 2010;
784 my ($input, $err, $answer, $X, $status, $Answer);
786 ok(195, ($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION,
787 -Strategy => Z_DEFAULT_STRATEGY) ) ;
789 ok(197, $err == Z_OK) ;
791 ok(198, $x->get_Level() == Z_BEST_COMPRESSION);
792 ok(199, $x->get_Strategy() == Z_DEFAULT_STRATEGY);
794 ($Answer, $status) = $x->deflate($hello) ;
795 ok(200, $status == Z_OK) ;
799 eval { $x->deflateParams() };
800 ok(201, $@ =~ m#^deflateParams needs Level and/or Strategy#);
802 eval { $x->deflateParams(-Joe => 3) };
803 ok(202, $@ =~ /^unknown key value\(s\) Joe at/);
805 ok(203, $x->get_Level() == Z_BEST_COMPRESSION);
806 ok(204, $x->get_Strategy() == Z_DEFAULT_STRATEGY);
808 # change both Level & Strategy
809 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
810 ok(205, $status == Z_OK) ;
812 ok(206, $x->get_Level() == Z_BEST_SPEED);
813 ok(207, $x->get_Strategy() == Z_HUFFMAN_ONLY);
815 ($X, $status) = $x->deflate($goodbye) ;
816 ok(208, $status == Z_OK) ;
821 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
822 ok(209, $status == Z_OK) ;
824 ok(210, $x->get_Level() == Z_NO_COMPRESSION);
825 ok(211, $x->get_Strategy() == Z_HUFFMAN_ONLY);
827 ($X, $status) = $x->deflate($goodbye) ;
828 ok(212, $status == Z_OK) ;
832 # change only Strategy
833 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
834 ok(213, $status == Z_OK) ;
836 ok(214, $x->get_Level() == Z_NO_COMPRESSION);
837 ok(215, $x->get_Strategy() == Z_FILTERED);
839 ($X, $status) = $x->deflate($goodbye) ;
840 ok(216, $status == Z_OK) ;
844 ok(217, (($X, $status) = $x->flush())[1] == Z_OK ) ;
847 my ($first, @Answer) = split('', $Answer) ;
850 ok(218, ($k, $err) = inflateInit()) ;
852 ok(220, $err == Z_OK) ;
854 ($Z, $status) = $k->inflate($Answer) ;
856 ok(221, $status == Z_STREAM_END) ;
857 ok(222, $Z eq $input ) ;
863 eval { deflateInit(-Level) };
864 ok(223, $@ =~ /^Compress::Zlib::deflateInit: parameter is not a reference to a hash at/);
866 eval { inflateInit(-Level) };
867 ok(224, $@ =~ /^Compress::Zlib::inflateInit: parameter is not a reference to a hash at/);
869 eval { deflateInit(-Joe => 1) };
870 ok(225, $@ =~ /^unknown key value\(s\) Joe at/);
872 eval { inflateInit(-Joe => 1) };
873 ok(226, $@ =~ /^unknown key value\(s\) Joe at/);
875 eval { deflateInit(-Bufsize => 0) };
876 ok(227, $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/);
878 eval { inflateInit(-Bufsize => 0) };
879 ok(228, $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/);
881 eval { deflateInit(-Bufsize => -1) };
882 ok(229, $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/);
884 eval { inflateInit(-Bufsize => -1) };
885 ok(230, $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/);
887 eval { deflateInit(-Bufsize => "xxx") };
888 ok(231, $@ =~ /^.*?: Bufsize must be >= 1, you specified xxx at/);
890 eval { inflateInit(-Bufsize => "xxx") };
891 ok(232, $@ =~ /^.*?: Bufsize must be >= 1, you specified xxx at/);
896 # test inflate with a substr
898 ok(233, my $x = deflateInit() ) ;
900 ok(234, (my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
906 ok(235, (($X, $status) = $x->flush() )[1] == Z_OK ) ;
909 my $append = "Appended" ;
912 ok(236, $k = inflateInit() ) ;
914 ($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
916 ok(237, $status == Z_STREAM_END) ;
917 #print "status $status Y [$Y]\n" ;
918 ok(238, $contents eq $Z ) ;
919 ok(239, $Y eq $append);