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) { |
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 | |
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 | |
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 |
521 | title 'memGunzip with a gzopen created file'; |
522 | { |
523 | my $name = "test.gz" ; |
524 | my $buffer = <<EOM; |
525 | some sample |
526 | text |
527 | |
528 | EOM |
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 | |
808 | if ($] >= 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 | |
837 | if ($] >= 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; |
906 | some text |
907 | EOM |
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 | |
948 | for 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; |
952 | some text |
953 | EOM |
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 | |
968 | my $Name = "fred" ; |
969 | for 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; |
973 | some text |
974 | EOM |
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 | |
986 | my $Comment = "comment" ; |
987 | for 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; |
991 | some text |
992 | EOM |
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 | |
1003 | for 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; |
1007 | some text |
1008 | EOM |
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; |
1023 | some text |
1024 | EOM |
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; |
1049 | some text |
1050 | EOM |
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 | |