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