Commit | Line | Data |
16816334 |
1 | BEGIN { |
d695c1a1 |
2 | if ($ENV{PERL_CORE}) { |
16816334 |
3 | chdir 't' if -d 't'; |
0ecadccd |
4 | @INC = ("../lib", "lib"); |
16816334 |
5 | } |
6 | } |
642e522c |
7 | |
8 | use lib 't'; |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use ZlibTestUtils; |
15 | use Symbol; |
16 | |
17 | BEGIN |
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 | |
42 | my $hello = <<EOM ; |
43 | hello world |
44 | this is a test |
45 | EOM |
46 | |
47 | my $len = length $hello ; |
48 | |
49 | # Check zlib_version and ZLIB_VERSION are the same. |
50 | is Compress::Zlib::zlib_version, ZLIB_VERSION, |
51 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; |
52 | |
53 | # generate a long random string |
54 | my $contents = '' ; |
55 | foreach (1 .. 5000) |
56 | { $contents .= chr int rand 256 } |
57 | |
58 | my $x ; |
59 | my $fil; |
60 | |
61 | # compress/uncompress tests |
62 | # ========================= |
63 | |
64 | eval { compress([1]); }; |
65 | ok $@ =~ m#not a scalar reference# |
66 | or print "# $@\n" ;; |
67 | |
68 | eval { uncompress([1]); }; |
69 | ok $@ =~ m#not a scalar reference# |
70 | or print "# $@\n" ;; |
71 | |
72 | $hello = "hello mum" ; |
73 | my $keep_hello = $hello ; |
74 | |
75 | my $compr = compress($hello) ; |
76 | ok $compr ne "" ; |
77 | |
78 | my $keep_compr = $compr ; |
79 | |
80 | my $uncompr = uncompress ($compr) ; |
81 | |
82 | ok $hello eq $uncompr ; |
83 | |
84 | ok $hello eq $keep_hello ; |
85 | ok $compr eq $keep_compr ; |
86 | |
87 | # compress a number |
88 | $hello = 7890 ; |
89 | $keep_hello = $hello ; |
90 | |
91 | $compr = compress($hello) ; |
92 | ok $compr ne "" ; |
93 | |
94 | $keep_compr = $compr ; |
95 | |
96 | $uncompr = uncompress ($compr) ; |
97 | |
98 | ok $hello eq $uncompr ; |
99 | |
100 | ok $hello eq $keep_hello ; |
101 | ok $compr eq $keep_compr ; |
102 | |
103 | # bigger compress |
104 | |
105 | $compr = compress ($contents) ; |
106 | ok $compr ne "" ; |
107 | |
108 | $uncompr = uncompress ($compr) ; |
109 | |
110 | ok $contents eq $uncompr ; |
111 | |
112 | # buffer reference |
113 | |
114 | $compr = compress(\$hello) ; |
115 | ok $compr ne "" ; |
116 | |
117 | |
118 | $uncompr = uncompress (\$compr) ; |
119 | ok $hello eq $uncompr ; |
120 | |
121 | # bad level |
122 | $compr = compress($hello, 1000) ; |
123 | ok ! defined $compr; |
124 | |
125 | # change level |
126 | $compr = compress($hello, Z_BEST_COMPRESSION) ; |
127 | ok defined $compr; |
128 | $uncompr = uncompress (\$compr) ; |
129 | ok $hello eq $uncompr ; |
130 | |
131 | # corrupt data |
132 | $compr = compress(\$hello) ; |
133 | ok $compr ne "" ; |
134 | |
135 | substr($compr,0, 1) = "\xFF"; |
136 | ok !defined uncompress (\$compr) ; |
137 | |
138 | # deflate/inflate - small buffer |
139 | # ============================== |
140 | |
141 | $hello = "I am a HAL 9000 computer" ; |
142 | my @hello = split('', $hello) ; |
143 | my ($err, $X, $status); |
144 | |
145 | ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; |
146 | ok $x ; |
147 | ok $err == Z_OK ; |
148 | |
149 | my $Answer = ''; |
150 | foreach (@hello) |
151 | { |
152 | ($X, $status) = $x->deflate($_) ; |
153 | last unless $status == Z_OK ; |
154 | |
155 | $Answer .= $X ; |
156 | } |
157 | |
158 | ok $status == Z_OK ; |
159 | |
160 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; |
161 | $Answer .= $X ; |
162 | |
163 | |
164 | my @Answer = split('', $Answer) ; |
165 | |
166 | my $k; |
167 | ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; |
168 | ok $k ; |
169 | ok $err == Z_OK ; |
170 | |
171 | my $GOT = ''; |
172 | my $Z; |
173 | foreach (@Answer) |
174 | { |
175 | ($Z, $status) = $k->inflate($_) ; |
176 | $GOT .= $Z ; |
177 | last if $status == Z_STREAM_END or $status != Z_OK ; |
178 | |
179 | } |
180 | |
181 | ok $status == Z_STREAM_END ; |
182 | ok $GOT eq $hello ; |
183 | |
184 | |
185 | title 'deflate/inflate - small buffer with a number'; |
186 | # ============================== |
187 | |
188 | $hello = 6529 ; |
189 | |
190 | ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; |
191 | ok $x ; |
192 | ok $err == Z_OK ; |
193 | |
194 | ok !defined $x->msg() ; |
195 | ok $x->total_in() == 0 ; |
196 | ok $x->total_out() == 0 ; |
197 | $Answer = ''; |
198 | { |
199 | ($X, $status) = $x->deflate($hello) ; |
200 | |
201 | $Answer .= $X ; |
202 | } |
203 | |
204 | ok $status == Z_OK ; |
205 | |
206 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; |
207 | $Answer .= $X ; |
208 | |
209 | ok !defined $x->msg() ; |
210 | ok $x->total_in() == length $hello ; |
211 | ok $x->total_out() == length $Answer ; |
212 | |
213 | |
214 | @Answer = split('', $Answer) ; |
215 | |
216 | ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; |
217 | ok $k ; |
218 | ok $err == Z_OK ; |
219 | |
220 | ok !defined $k->msg() ; |
221 | ok $k->total_in() == 0 ; |
222 | ok $k->total_out() == 0 ; |
223 | |
224 | $GOT = ''; |
225 | foreach (@Answer) |
226 | { |
227 | ($Z, $status) = $k->inflate($_) ; |
228 | $GOT .= $Z ; |
229 | last if $status == Z_STREAM_END or $status != Z_OK ; |
230 | |
231 | } |
232 | |
233 | ok $status == Z_STREAM_END ; |
234 | ok $GOT eq $hello ; |
235 | |
236 | ok !defined $k->msg() ; |
237 | is $k->total_in(), length $Answer ; |
238 | ok $k->total_out() == length $hello ; |
239 | |
240 | |
241 | |
242 | title 'deflate/inflate - larger buffer'; |
243 | # ============================== |
244 | |
245 | |
246 | ok $x = deflateInit() ; |
247 | |
248 | ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ; |
249 | |
250 | my $Y = $X ; |
251 | |
252 | |
253 | ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; |
254 | $Y .= $X ; |
255 | |
256 | |
257 | |
258 | ok $k = inflateInit() ; |
259 | |
260 | ($Z, $status) = $k->inflate($Y) ; |
261 | |
262 | ok $status == Z_STREAM_END ; |
263 | ok $contents eq $Z ; |
264 | |
265 | title 'deflate/inflate - preset dictionary'; |
266 | # =================================== |
267 | |
268 | my $dictionary = "hello" ; |
269 | ok $x = deflateInit({-Level => Z_BEST_COMPRESSION, |
270 | -Dictionary => $dictionary}) ; |
271 | |
272 | my $dictID = $x->dict_adler() ; |
273 | |
274 | ($X, $status) = $x->deflate($hello) ; |
275 | ok $status == Z_OK ; |
276 | ($Y, $status) = $x->flush() ; |
277 | ok $status == Z_OK ; |
278 | $X .= $Y ; |
279 | $x = 0 ; |
280 | |
281 | ok $k = inflateInit(-Dictionary => $dictionary) ; |
282 | |
283 | ($Z, $status) = $k->inflate($X); |
284 | ok $status == Z_STREAM_END ; |
285 | ok $k->dict_adler() == $dictID; |
286 | ok $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 | |
303 | title '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 | |
333 | title 'memGzip & memGunzip'; |
334 | { |
335 | my $name = "test.gz" ; |
336 | my $buffer = <<EOM; |
337 | some sample |
338 | text |
339 | |
340 | EOM |
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 | |
494 | title 'memGunzip with a gzopen created file'; |
495 | { |
496 | my $name = "test.gz" ; |
497 | my $buffer = <<EOM; |
498 | some sample |
499 | text |
500 | |
501 | EOM |
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 | |
781 | if ($] >= 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 | |
810 | if ($] >= 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; |
879 | some text |
880 | EOM |
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 | |
921 | for 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; |
925 | some text |
926 | EOM |
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 | |
941 | my $Name = "fred" ; |
942 | for 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; |
946 | some text |
947 | EOM |
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 | |
959 | my $Comment = "comment" ; |
960 | for 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; |
964 | some text |
965 | EOM |
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 | |
976 | for 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; |
980 | some text |
981 | EOM |
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; |
996 | some text |
997 | EOM |
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; |
1022 | some text |
1023 | EOM |
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 | |