Fix Compress::Zlib test boilerplate
[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';
4 @INC = '../lib';
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) {
26 $count = 340 ;
27 }
28 else {
29 $count = 351 ;
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
366 unlink $name ;
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
445 unlink $name ;
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
494title 'memGunzip with a gzopen created file';
495{
496 my $name = "test.gz" ;
497 my $buffer = <<EOM;
498some sample
499text
500
501EOM
502
503 ok $fil = gzopen($name, "wb") ;
504
505 ok $fil->gzwrite($buffer) == length $buffer ;
506
507 ok ! $fil->gzclose ;
508
509 my $compr = readFile($name);
510 ok length $compr ;
511 my $unc = Compress::Zlib::memGunzip($compr) ;
512 ok defined $unc ;
513 ok $buffer eq $unc ;
514 unlink $name ;
515}
516
517{
518
519 # Check - MAX_WBITS
520 # =================
521
522 $hello = "Test test test test test";
523 @hello = split('', $hello) ;
524
525 ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
526 ok $x ;
527 ok $err == Z_OK ;
528
529 $Answer = '';
530 foreach (@hello)
531 {
532 ($X, $status) = $x->deflate($_) ;
533 last unless $status == Z_OK ;
534
535 $Answer .= $X ;
536 }
537
538 ok $status == Z_OK ;
539
540 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
541 $Answer .= $X ;
542
543
544 @Answer = split('', $Answer) ;
545 # Undocumented corner -- extra byte needed to get inflate to return
546 # Z_STREAM_END when done.
547 push @Answer, " " ;
548
549 ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
550 ok $k ;
551 ok $err == Z_OK ;
552
553 $GOT = '';
554 foreach (@Answer)
555 {
556 ($Z, $status) = $k->inflate($_) ;
557 $GOT .= $Z ;
558 last if $status == Z_STREAM_END or $status != Z_OK ;
559
560 }
561
562 ok $status == Z_STREAM_END ;
563 ok $GOT eq $hello ;
564
565}
566
567{
568 # inflateSync
569
570 # create a deflate stream with flush points
571
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);
575
576 ok (($x, $err) = deflateInit() ) ;
577 ok $x ;
578 ok $err == Z_OK ;
579
580 ($Answer, $status) = $x->deflate($hello) ;
581 ok $status == Z_OK ;
582
583 # create a flush point
584 ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
585 $Answer .= $X ;
586
587 ($X, $status) = $x->deflate($goodbye) ;
588 ok $status == Z_OK ;
589 $Answer .= $X ;
590
591 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
592 $Answer .= $X ;
593
594 my ($first, @Answer) = split('', $Answer) ;
595
596 my $k;
597 ok (($k, $err) = inflateInit()) ;
598 ok $k ;
599 ok $err == Z_OK ;
600
601 ($Z, $status) = $k->inflate($first) ;
602 ok $status == Z_OK ;
603
604 # skip to the first flush point.
605 while (@Answer)
606 {
607 my $byte = shift @Answer;
608 $status = $k->inflateSync($byte) ;
609 last unless $status == Z_DATA_ERROR;
610
611 }
612
613 ok $status == Z_OK;
614
615 my $GOT = '';
616 my $Z = '';
617 foreach (@Answer)
618 {
619 my $Z = '';
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 ;
624
625 }
626
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 ;
630
631
632 # Check inflateSync leaves good data in buffer
633 $Answer =~ /^(.)(.*)$/ ;
634 my ($initial, $rest) = ($1, $2);
635
636
637 ok (($k, $err) = inflateInit()) ;
638 ok $k ;
639 ok $err == Z_OK ;
640
641 ($Z, $status) = $k->inflate($initial) ;
642 ok $status == Z_OK ;
643
644 $status = $k->inflateSync($rest) ;
645 ok $status == Z_OK;
646
647 ($GOT, $status) = $k->inflate($rest) ;
648
649 ok $status == Z_DATA_ERROR ;
650 ok $Z . $GOT eq $goodbye ;
651}
652
653{
654 # deflateParams
655
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);
659
660 ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION,
661 -Strategy => Z_DEFAULT_STRATEGY) ) ;
662 ok $x ;
663 ok $err == Z_OK ;
664
665 ok $x->get_Level() == Z_BEST_COMPRESSION;
666 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
667
668 ($Answer, $status) = $x->deflate($hello) ;
669 ok $status == Z_OK ;
670 $input .= $hello;
671
672 # error cases
673 eval { $x->deflateParams() };
674 ok $@ =~ m#^Compress::Zlib::deflateParams needs Level and/or Strategy#;
675
676 eval { $x->deflateParams(-Joe => 3) };
677 ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
678 or print "# $@\n" ;
679
680 ok $x->get_Level() == Z_BEST_COMPRESSION;
681 ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
682
683 # change both Level & Strategy
684 $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
685 ok $status == Z_OK ;
686
687 ok $x->get_Level() == Z_BEST_SPEED;
688 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
689
690 ($X, $status) = $x->deflate($goodbye) ;
691 ok $status == Z_OK ;
692 $Answer .= $X ;
693 $input .= $goodbye;
694
695 # change only Level
696 $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
697 ok $status == Z_OK ;
698
699 ok $x->get_Level() == Z_NO_COMPRESSION;
700 ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
701
702 ($X, $status) = $x->deflate($goodbye) ;
703 ok $status == Z_OK ;
704 $Answer .= $X ;
705 $input .= $goodbye;
706
707 # change only Strategy
708 $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
709 ok $status == Z_OK ;
710
711 ok $x->get_Level() == Z_NO_COMPRESSION;
712 ok $x->get_Strategy() == Z_FILTERED;
713
714 ($X, $status) = $x->deflate($goodbye) ;
715 ok $status == Z_OK ;
716 $Answer .= $X ;
717 $input .= $goodbye;
718
719 ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
720 $Answer .= $X ;
721
722 my ($first, @Answer) = split('', $Answer) ;
723
724 my $k;
725 ok (($k, $err) = inflateInit()) ;
726 ok $k ;
727 ok $err == Z_OK ;
728
729 ($Z, $status) = $k->inflate($Answer) ;
730
731 ok $status == Z_STREAM_END
732 or print "# status $status\n";
733 ok $Z eq $input ;
734}
735
736{
737 # error cases
738
739 eval { deflateInit(-Level) };
740 like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';
741
742 eval { inflateInit(-Level) };
743 like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';
744
745 eval { deflateInit(-Joe => 1) };
746 ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;
747
748 eval { inflateInit(-Joe => 1) };
749 ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;
750
751 eval { deflateInit(-Bufsize => 0) };
752 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
753
754 eval { inflateInit(-Bufsize => 0) };
755 ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;
756
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'/;
760
761 eval { inflateInit(-Bufsize => -1) };
762 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;
763
764 eval { deflateInit(-Bufsize => "xxx") };
765 ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
766
767 eval { inflateInit(-Bufsize => "xxx") };
768 ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;
769
770 eval { gzopen([], 0) ; } ;
771 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
772 or print "# $@\n" ;
773
774 my $x = Symbol::gensym() ;
775 eval { gzopen($x, 0) ; } ;
776 ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
777 or print "# $@\n" ;
778
779}
780
781if ($] >= 5.005)
782{
783 # test inflate with a substr
784
785 ok my $x = deflateInit() ;
786
787 ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ;
788
789 my $Y = $X ;
790
791
792
793 ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
794 $Y .= $X ;
795
796 my $append = "Appended" ;
797 $Y .= $append ;
798
799 ok $k = inflateInit() ;
800
801 #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
802 ($Z, $status) = $k->inflate(substr($Y, 0)) ;
803
804 ok $status == Z_STREAM_END ;
805 ok $contents eq $Z ;
806 is $Y, $append;
807
808}
809
810if ($] >= 5.005)
811{
812 # deflate/inflate in scalar context
813
814 ok my $x = deflateInit() ;
815
816 my $X = $x->deflate($contents);
817
818 my $Y = $X ;
819
820
821
822 $X = $x->flush();
823 $Y .= $X ;
824
825 my $append = "Appended" ;
826 $Y .= $append ;
827
828 ok $k = inflateInit() ;
829
830 #$Z = $k->inflate(substr($Y, 0, -1)) ;
831 $Z = $k->inflate(substr($Y, 0)) ;
832
833 ok $contents eq $Z ;
834 is $Y, $append;
835
836}
837
838{
839 title 'CRC32' ;
840
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;
845}
846
847{
848 title 'Adler32' ;
849
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;
854}
855
856{
857 # memGunzip - input > 4K
858
859 my $contents = '' ;
860 foreach (1 .. 20000)
861 { $contents .= chr int rand 256 }
862
863 ok my $compressed = Compress::Zlib::memGzip(\$contents) ;
864
865 ok length $compressed > 4096 ;
866 ok my $out = Compress::Zlib::memGunzip(\$compressed) ;
867
868 ok $contents eq $out ;
869 is length $out, length $contents ;
870
871
872}
873
874
875{
876 # memGunzip Header Corruption Tests
877
878 my $string = <<EOM;
879some text
880EOM
881
882 my $good ;
883 ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
884 ok $x->write($string) ;
885 ok $x->close ;
886
887 {
888 title "Header Corruption - Fingerprint wrong 1st byte" ;
889 my $buffer = $good ;
890 substr($buffer, 0, 1) = 'x' ;
891
892 ok ! Compress::Zlib::memGunzip(\$buffer) ;
893 }
894
895 {
896 title "Header Corruption - Fingerprint wrong 2nd byte" ;
897 my $buffer = $good ;
898 substr($buffer, 1, 1) = "\xFF" ;
899
900 ok ! Compress::Zlib::memGunzip(\$buffer) ;
901 }
902
903 {
904 title "Header Corruption - CM not 8";
905 my $buffer = $good ;
906 substr($buffer, 2, 1) = 'x' ;
907
908 ok ! Compress::Zlib::memGunzip(\$buffer) ;
909 }
910
911 {
912 title "Header Corruption - Use of Reserved Flags";
913 my $buffer = $good ;
914 substr($buffer, 3, 1) = "\xff";
915
916 ok ! Compress::Zlib::memGunzip(\$buffer) ;
917 }
918
919}
920
921for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
922{
923 title "Header Corruption - Truncated in Extra";
924 my $string = <<EOM;
925some text
926EOM
927
928 my $truncated ;
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) ;
932 ok $x->close ;
933
934 substr($truncated, $index) = '' ;
935
936 ok ! Compress::Zlib::memGunzip(\$truncated) ;
937
938
939}
940
941my $Name = "fred" ;
942for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1)
943{
944 title "Header Corruption - Truncated in Name";
945 my $string = <<EOM;
946some text
947EOM
948
949 my $truncated ;
950 ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
951 ok $x->write($string) ;
952 ok $x->close ;
953
954 substr($truncated, $index) = '' ;
955
956 ok ! Compress::Zlib::memGunzip(\$truncated) ;
957}
958
959my $Comment = "comment" ;
960for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1)
961{
962 title "Header Corruption - Truncated in Comment";
963 my $string = <<EOM;
964some text
965EOM
966
967 my $truncated ;
968 ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
969 ok $x->write($string) ;
970 ok $x->close ;
971
972 substr($truncated, $index) = '' ;
973 ok ! Compress::Zlib::memGunzip(\$truncated) ;
974}
975
976for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
977{
978 title "Header Corruption - Truncated in CRC";
979 my $string = <<EOM;
980some text
981EOM
982
983 my $truncated ;
984 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
985 ok $x->write($string) ;
986 ok $x->close ;
987
988 substr($truncated, $index) = '' ;
989
990 ok ! Compress::Zlib::memGunzip(\$truncated) ;
991}
992
993{
994 title "memGunzip can cope with a gzip header with all possible fields";
995 my $string = <<EOM;
996some text
997EOM
998
999 my $buffer ;
1000 ok my $x = new IO::Compress::Gzip \$buffer,
1001 -Append => 1,
1002 -Strict => 0,
1003 -HeaderCRC => 1,
1004 -Name => "Fred",
1005 -ExtraField => "Extra",
1006 -Comment => 'Comment';
1007 ok $x->write($string) ;
1008 ok $x->close ;
1009
1010 ok defined $buffer ;
1011
1012 ok my $got = Compress::Zlib::memGunzip($buffer)
1013 or diag "gzerrno is $gzerrno" ;
1014 is $got, $string ;
1015}
1016
1017
1018{
1019 # Trailer Corruption tests
1020
1021 my $string = <<EOM;
1022some text
1023EOM
1024
1025 my $good ;
1026 ok my $x = new IO::Compress::Gzip \$good, Append => 1 ;
1027 ok $x->write($string) ;
1028 ok $x->close ;
1029
1030 foreach my $trim (-8 .. -1)
1031 {
1032 my $got = $trim + 8 ;
1033 title "Trailer Corruption - Trailer truncated to $got bytes" ;
1034 my $buffer = $good ;
1035
1036 substr($buffer, $trim) = '';
1037
1038 ok my $u = Compress::Zlib::memGunzip(\$buffer) ;
1039 ok $u eq $string;
1040
1041 }
1042
1043 {
1044 title "Trailer Corruption - Length Wrong, CRC Correct" ;
1045 my $buffer = $good ;
1046 substr($buffer, -4, 4) = pack('V', 1234);
1047
1048 ok ! Compress::Zlib::memGunzip(\$buffer) ;
1049 }
1050
1051 {
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);
1056
1057 ok ! Compress::Zlib::memGunzip(\$buffer) ;
1058
1059 }
1060}
1061
1062
1063
1064