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