4 @INC = ("../lib", "lib/compress");
8 use lib qw(t t/compress);
19 # use Test::NoWarnings, if available
22 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
36 plan tests => $count + $extra;
38 use_ok('Compress::Raw::Zlib', 2) ;
47 my $len = length $hello ;
49 # Check zlib_version and ZLIB_VERSION are the same.
50 is Compress::Raw::Zlib::zlib_version, ZLIB_VERSION,
51 "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ;
56 eval { new Compress::Raw::Zlib::Deflate(-Level) };
57 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 1") ;
59 eval { new Compress::Raw::Zlib::Inflate(-Level) };
60 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 1");
62 eval { new Compress::Raw::Zlib::Deflate(-Joe => 1) };
63 like $@, mkErr('^Compress::Raw::Zlib::Deflate::new: unknown key value\(s\) Joe');
65 eval { new Compress::Raw::Zlib::Inflate(-Joe => 1) };
66 like $@, mkErr('^Compress::Raw::Zlib::Inflate::new: unknown key value\(s\) Joe');
68 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 0) };
69 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified 0");
71 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 0) };
72 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified 0");
74 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => -1) };
75 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
77 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => -1) };
78 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'");
80 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => "xxx") };
81 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
83 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => "xxx") };
84 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'");
86 eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 1, 2) };
87 like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 3");
89 eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 1, 2) };
90 like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 3");
96 title "deflate/inflate - small buffer";
97 # ==============================
99 my $hello = "I am a HAL 9000 computer" ;
100 my @hello = split('', $hello) ;
101 my ($err, $x, $X, $status);
103 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ), "Create deflate object" );
104 ok $x, "Compress::Raw::Zlib::Deflate ok" ;
105 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
107 ok ! defined $x->msg() ;
108 is $x->total_in(), 0, "total_in() == 0" ;
109 is $x->total_out(), 0, "total_out() == 0" ;
115 $status = $x->deflate($_, $X) ;
116 last unless $status == Z_OK ;
121 cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ;
123 cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ;
126 ok ! defined $x->msg() ;
127 is $x->total_in(), length $hello, "total_in ok" ;
128 is $x->total_out(), length $Answer, "total_out ok" ;
130 my @Answer = split('', $Answer) ;
133 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1}) );
134 ok $k, "Compress::Raw::Zlib::Inflate ok" ;
135 cmp_ok $err, '==', Z_OK, "status is Z_OK" ;
137 ok ! defined $k->msg(), "No error messages" ;
138 is $k->total_in(), 0, "total_in() == 0" ;
139 is $k->total_out(), 0, "total_out() == 0" ;
145 $status = $k->inflate($_, $Z) ;
147 last if $status == Z_STREAM_END or $status != Z_OK ;
151 cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ;
152 is $GOT, $hello, "uncompressed data matches ok" ;
153 ok ! defined $k->msg(), "No error messages" ;
154 is $k->total_in(), length $Answer, "total_in ok" ;
155 is $k->total_out(), length $hello , "total_out ok";
161 # deflate/inflate - small buffer with a number
162 # ==============================
166 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, -AppendOutput => 1 ) ;
168 cmp_ok $err, '==', Z_OK ;
173 cmp_ok $x->deflate($hello, $Answer), '==', Z_OK ;
175 cmp_ok $x->flush($Answer), '==', Z_OK ;
177 my @Answer = split('', $Answer) ;
180 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}) );
182 cmp_ok $err, '==', Z_OK ;
188 $status = $k->inflate($_, $GOT) ;
189 last if $status == Z_STREAM_END or $status != Z_OK ;
193 cmp_ok $status, '==', Z_STREAM_END ;
200 # deflate/inflate options - AppendOutput
201 # ================================
206 my $hello = "I am a HAL 9000 computer" ;
207 my @hello = split('', $hello) ;
209 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( {-Bufsize => 1, -AppendOutput =>1} ) ;
211 cmp_ok $err, '==', Z_OK ;
217 $status = $x->deflate($_, $X) ;
218 last unless $status == Z_OK ;
221 cmp_ok $status, '==', Z_OK ;
223 cmp_ok $x->flush($X), '==', Z_OK ;
226 my @Answer = split('', $X) ;
229 ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}));
231 cmp_ok $err, '==', Z_OK ;
236 $status = $k->inflate($_, $Z) ;
237 last if $status == Z_STREAM_END or $status != Z_OK ;
241 cmp_ok $status, '==', Z_STREAM_END ;
248 title "deflate/inflate - larger buffer";
249 # ==============================
251 # generate a long random string
254 { $contents .= chr int rand 255 }
257 ok my ($x, $err) = new Compress::Raw::Zlib::Deflate() ;
259 cmp_ok $err, '==', Z_OK ;
261 my (%X, $Y, %Z, $X, $Z);
262 #cmp_ok $x->deflate($contents, $X{key}), '==', Z_OK ;
263 cmp_ok $x->deflate($contents, $X), '==', Z_OK ;
269 #cmp_ok $x->flush($X{key}), '==', Z_OK ;
271 cmp_ok $x->flush($X), '==', Z_OK ;
279 ok(($k, $err) = new Compress::Raw::Zlib::Inflate() );
281 cmp_ok $err, '==', Z_OK ;
283 #cmp_ok $k->inflate($Y, $Z{key}), '==', Z_STREAM_END ;
284 #ok $contents eq $Z{key} ;
285 cmp_ok $k->inflate($Y, $Z), '==', Z_STREAM_END ;
288 # redo deflate with AppendOutput
290 ok (($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1)) ;
292 cmp_ok $err, '==', Z_OK ;
296 my @bits = split('', $keep) ;
297 foreach my $bit (@bits) {
298 $s = $k->inflate($bit, $out) ;
301 cmp_ok $s, '==', Z_STREAM_END ;
303 ok $contents eq $out ;
310 title "deflate/inflate - preset dictionary";
311 # ===================================
313 my $dictionary = "hello" ;
314 ok my $x = new Compress::Raw::Zlib::Deflate({-Level => Z_BEST_COMPRESSION,
315 -Dictionary => $dictionary}) ;
317 my $dictID = $x->dict_adler() ;
320 cmp_ok $x->deflate($hello, $X), '==', Z_OK;
321 cmp_ok $x->flush($Y), '==', Z_OK;
324 ok my $k = new Compress::Raw::Zlib::Inflate(-Dictionary => $dictionary) ;
326 cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END;
327 is $k->dict_adler(), $dictID;
332 title 'inflate - check remaining buffer after Z_STREAM_END';
333 # and that ConsumeInput works.
334 # ===================================================
336 for my $consume ( 0 .. 1)
338 ok my $x = new Compress::Raw::Zlib::Deflate(-Level => Z_BEST_COMPRESSION ) ;
341 cmp_ok $x->deflate($hello, $X), '==', Z_OK;
342 cmp_ok $x->flush($Y), '==', Z_OK;
345 ok my $k = new Compress::Raw::Zlib::Inflate( -ConsumeInput => $consume) ;
347 my $first = substr($X, 0, 2) ;
348 my $remember_first = $first ;
349 my $last = substr($X, 2) ;
350 cmp_ok $k->inflate($first, $Z), '==', Z_OK;
355 ok $first eq $remember_first ;
359 $last .= "appendage" ;
360 my $remember_last = $last ;
361 cmp_ok $k->inflate($last, $T), '==', Z_STREAM_END;
364 is $last, "appendage" ;
367 is $last, $remember_last ;
376 title 'Check - MAX_WBITS';
379 my $hello = "Test test test test test";
380 my @hello = split('', $hello) ;
383 new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
384 -WindowBits => -MAX_WBITS(),
385 -AppendOutput => 1 ) ;
387 cmp_ok $err, '==', Z_OK ;
393 $status = $x->deflate($_, $Answer) ;
394 last unless $status == Z_OK ;
397 cmp_ok $status, '==', Z_OK ;
399 cmp_ok $x->flush($Answer), '==', Z_OK ;
401 my @Answer = split('', $Answer) ;
402 # Undocumented corner -- extra byte needed to get inflate to return
403 # Z_STREAM_END when done.
407 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(
410 -WindowBits => -MAX_WBITS()})) ;
412 cmp_ok $err, '==', Z_OK ;
417 $status = $k->inflate($_, $GOT) ;
418 last if $status == Z_STREAM_END or $status != Z_OK ;
422 cmp_ok $status, '==', Z_STREAM_END ;
430 # create a deflate stream with flush points
432 my $hello = "I am a HAL 9000 computer" x 2001 ;
433 my $goodbye = "Will I dream?" x 2010;
434 my ($x, $err, $answer, $X, $Z, $status);
438 ok(($x, $err) = new Compress::Raw::Zlib::Deflate(AppendOutput => 1)) ;
440 cmp_ok $err, '==', Z_OK ;
442 cmp_ok $x->deflate($hello, $Answer), '==', Z_OK;
444 # create a flush point
445 cmp_ok $x->flush($Answer, Z_FULL_FLUSH), '==', Z_OK ;
447 cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK;
449 cmp_ok $x->flush($Answer), '==', Z_OK ;
451 my ($first, @Answer) = split('', $Answer) ;
454 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
456 cmp_ok $err, '==', Z_OK ;
458 cmp_ok $k->inflate($first, $Z), '==', Z_OK;
460 # skip to the first flush point.
463 my $byte = shift @Answer;
464 $status = $k->inflateSync($byte) ;
465 last unless $status == Z_DATA_ERROR;
468 cmp_ok $status, '==', Z_OK;
474 $status = $k->inflate($_, $Z) ;
475 $GOT .= $Z if defined $Z ;
476 # print "x $status\n";
477 last if $status == Z_STREAM_END or $status != Z_OK ;
481 cmp_ok $status, '==', Z_DATA_ERROR ;
485 # Check inflateSync leaves good data in buffer
491 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 0)) ;
493 cmp_ok $err, '==', Z_OK ;
495 cmp_ok $k->inflate($initial, $Z), '==', Z_OK;
497 # Skip to the flush point
498 $status = $k->inflateSync($rest);
499 cmp_ok $status, '==', Z_OK
500 or diag "status '$status'\nlength rest is " . length($rest) . "\n" ;
502 cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR;
503 is $Z . $GOT, $goodbye ;
507 title 'deflateParams';
509 my $hello = "I am a HAL 9000 computer" x 2001 ;
510 my $goodbye = "Will I dream?" x 2010;
511 my ($x, $input, $err, $answer, $X, $status, $Answer);
513 ok(($x, $err) = new Compress::Raw::Zlib::Deflate(
515 -Level => Z_DEFAULT_COMPRESSION,
516 -Strategy => Z_DEFAULT_STRATEGY)) ;
518 cmp_ok $err, '==', Z_OK ;
520 ok $x->get_Level() == Z_DEFAULT_COMPRESSION;
521 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
523 $status = $x->deflate($hello, $Answer) ;
524 cmp_ok $status, '==', Z_OK ;
528 eval { $x->deflateParams() };
529 like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy');
531 eval { $x->deflateParams(-Bufsize => 0) };
532 like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0');
534 eval { $x->deflateParams(-Joe => 3) };
535 like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe');
537 is $x->get_Level(), Z_DEFAULT_COMPRESSION;
538 is $x->get_Strategy(), Z_DEFAULT_STRATEGY;
540 # change both Level & Strategy
541 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ;
542 cmp_ok $status, '==', Z_OK ;
544 is $x->get_Level(), Z_BEST_SPEED;
545 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
547 $status = $x->deflate($goodbye, $Answer) ;
548 cmp_ok $status, '==', Z_OK ;
552 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
553 cmp_ok $status, '==', Z_OK ;
555 is $x->get_Level(), Z_NO_COMPRESSION;
556 is $x->get_Strategy(), Z_HUFFMAN_ONLY;
558 $status = $x->deflate($goodbye, $Answer) ;
559 cmp_ok $status, '==', Z_OK ;
562 # change only Strategy
563 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
564 cmp_ok $status, '==', Z_OK ;
566 is $x->get_Level(), Z_NO_COMPRESSION;
567 is $x->get_Strategy(), Z_FILTERED;
569 $status = $x->deflate($goodbye, $Answer) ;
570 cmp_ok $status, '==', Z_OK ;
573 cmp_ok $x->flush($Answer), '==', Z_OK ;
576 ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ;
578 cmp_ok $err, '==', Z_OK ;
581 $status = $k->inflate($Answer, $Z) ;
583 cmp_ok $status, '==', Z_STREAM_END ;
589 title "ConsumeInput and a read-only buffer trapped" ;
591 ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ;
594 eval { $k->inflate("abc", $Z) ; };
595 like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified");
603 title 'test inflate/deflate with a substr';
607 { $contents .= chr int rand 255 }
608 ok my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ;
611 my $status = $x->deflate(substr($contents,0), $X);
612 cmp_ok $status, '==', Z_OK ;
614 cmp_ok $x->flush($X), '==', Z_OK ;
616 my $append = "Appended" ;
619 ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ;
623 $status = $k->inflate(substr($X, 0), $Z) ;
625 cmp_ok $status, '==', Z_STREAM_END ;
626 #print "status $status X [$X]\n" ;
629 #is length($X), length($append);
631 #is length($X), length($keep);
634 title 'Looping Append test - checks that deRef_l resets the output buffer';
638 my $hello = "I am a HAL 9000 computer" ;
639 my @hello = split('', $hello) ;
640 my ($err, $x, $X, $status);
642 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) );
644 cmp_ok $err, '==', Z_OK ;
650 $status = $x->deflate($_, $X) ;
651 last unless $status == Z_OK ;
656 cmp_ok $status, '==', Z_OK ;
658 cmp_ok $x->flush($X), '==', Z_OK ;
661 my @Answer = split('', $Answer) ;
664 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
666 cmp_ok $err, '==', Z_OK ;
673 $status = $k->inflate($_, $GOT) ;
674 last if $status == Z_STREAM_END or $status != Z_OK ;
677 cmp_ok $status, '==', Z_STREAM_END ;
684 title 'test inflate input parameter via substr';
686 my $hello = "I am a HAL 9000 computer" ;
691 ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 );
693 cmp_ok $x->deflate($data, $X), '==', Z_OK ;
695 cmp_ok $x->flush($X), '==', Z_OK ;
697 my $append = "Appended" ;
701 ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
702 -ConsumeInput => 1 ) ;
704 # cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
705 cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
712 ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1,
713 -ConsumeInput => 0 ) ;
715 cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ;
716 #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ;
724 # regression - check that resetLastBlockByte can cope with a NULL
726 Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef);
727 ok 1, "resetLastBlockByte(undef) is ok" ;
732 title 'Looping Append test with substr output - substr the end of the string';
736 my $hello = "I am a HAL 9000 computer" ;
737 my @hello = split('', $hello) ;
738 my ($err, $x, $X, $status);
740 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
741 -AppendOutput => 1 ) );
743 cmp_ok $err, '==', Z_OK ;
749 $status = $x->deflate($_, substr($Answer, length($Answer))) ;
750 last unless $status == Z_OK ;
754 cmp_ok $status, '==', Z_OK ;
756 cmp_ok $x->flush(substr($Answer, length($Answer))), '==', Z_OK ;
758 my @Answer = split('', $Answer) ;
761 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
763 cmp_ok $err, '==', Z_OK ;
770 $status = $k->inflate($_, substr($GOT, length($GOT))) ;
771 last if $status == Z_STREAM_END or $status != Z_OK ;
774 cmp_ok $status, '==', Z_STREAM_END ;
779 title 'Looping Append test with substr output - substr the complete string';
783 my $hello = "I am a HAL 9000 computer" ;
784 my @hello = split('', $hello) ;
785 my ($err, $x, $X, $status);
787 ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1,
788 -AppendOutput => 1 ) );
790 cmp_ok $err, '==', Z_OK ;
796 $status = $x->deflate($_, substr($Answer, 0)) ;
797 last unless $status == Z_OK ;
801 cmp_ok $status, '==', Z_OK ;
803 cmp_ok $x->flush(substr($Answer, 0)), '==', Z_OK ;
805 my @Answer = split('', $Answer) ;
808 ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) );
810 cmp_ok $err, '==', Z_OK ;
817 $status = $k->inflate($_, substr($GOT, 0)) ;
818 last if $status == Z_STREAM_END or $status != Z_OK ;
821 cmp_ok $status, '==', Z_STREAM_END ;