Commit | Line | Data |
25f0751f |
1 | BEGIN { |
2 | if ($ENV{PERL_CORE}) { |
3 | chdir 't' if -d 't'; |
4 | @INC = ("../lib", "lib/compress"); |
5 | } |
6 | } |
7 | |
8 | use lib qw(t t/compress); |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
13 | use Test::More ; |
14 | use CompTestUtils; |
15 | |
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 | |
25 | my $count = 0 ; |
26 | if ($] < 5.005) { |
319fab50 |
27 | $count = 230 ; |
25f0751f |
28 | } |
29 | elsif ($] >= 5.006) { |
319fab50 |
30 | $count = 284 ; |
25f0751f |
31 | } |
32 | else { |
319fab50 |
33 | $count = 242 ; |
25f0751f |
34 | } |
35 | |
36 | plan tests => $count + $extra; |
37 | |
38 | use_ok('Compress::Raw::Zlib', 2) ; |
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::Raw::Zlib::zlib_version, ZLIB_VERSION, |
51 | "ZLIB_VERSION matches Compress::Raw::Zlib::zlib_version" ; |
52 | |
53 | { |
54 | title "Error Cases" ; |
55 | |
56 | eval { new Compress::Raw::Zlib::Deflate(-Level) }; |
57 | like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 1") ; |
58 | |
59 | eval { new Compress::Raw::Zlib::Inflate(-Level) }; |
60 | like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 1"); |
61 | |
62 | eval { new Compress::Raw::Zlib::Deflate(-Joe => 1) }; |
63 | like $@, mkErr('^Compress::Raw::Zlib::Deflate::new: unknown key value\(s\) Joe'); |
64 | |
65 | eval { new Compress::Raw::Zlib::Inflate(-Joe => 1) }; |
66 | like $@, mkErr('^Compress::Raw::Zlib::Inflate::new: unknown key value\(s\) Joe'); |
67 | |
68 | eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 0) }; |
69 | like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Bufsize must be >= 1, you specified 0"); |
70 | |
71 | eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 0) }; |
72 | like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Bufsize must be >= 1, you specified 0"); |
73 | |
74 | eval { new Compress::Raw::Zlib::Deflate(-Bufsize => -1) }; |
75 | like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'"); |
76 | |
77 | eval { new Compress::Raw::Zlib::Inflate(-Bufsize => -1) }; |
78 | like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got '-1'"); |
79 | |
80 | eval { new Compress::Raw::Zlib::Deflate(-Bufsize => "xxx") }; |
81 | like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'"); |
82 | |
83 | eval { new Compress::Raw::Zlib::Inflate(-Bufsize => "xxx") }; |
84 | like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Parameter 'Bufsize' must be an unsigned int, got 'xxx'"); |
85 | |
86 | eval { new Compress::Raw::Zlib::Inflate(-Bufsize => 1, 2) }; |
87 | like $@, mkErr("^Compress::Raw::Zlib::Inflate::new: Expected even number of parameters, got 3"); |
88 | |
89 | eval { new Compress::Raw::Zlib::Deflate(-Bufsize => 1, 2) }; |
90 | like $@, mkErr("^Compress::Raw::Zlib::Deflate::new: Expected even number of parameters, got 3"); |
91 | |
92 | } |
93 | |
94 | { |
95 | |
96 | title "deflate/inflate - small buffer"; |
97 | # ============================== |
98 | |
99 | my $hello = "I am a HAL 9000 computer" ; |
100 | my @hello = split('', $hello) ; |
101 | my ($err, $x, $X, $status); |
102 | |
103 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ), "Create deflate object" ); |
104 | ok $x, "Compress::Raw::Zlib::Deflate ok" ; |
105 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
106 | |
107 | ok ! defined $x->msg() ; |
108 | is $x->total_in(), 0, "total_in() == 0" ; |
109 | is $x->total_out(), 0, "total_out() == 0" ; |
110 | |
111 | $X = "" ; |
112 | my $Answer = ''; |
113 | foreach (@hello) |
114 | { |
115 | $status = $x->deflate($_, $X) ; |
116 | last unless $status == Z_OK ; |
117 | |
118 | $Answer .= $X ; |
119 | } |
120 | |
121 | cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; |
122 | |
123 | cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ; |
124 | $Answer .= $X ; |
125 | |
126 | ok ! defined $x->msg() ; |
127 | is $x->total_in(), length $hello, "total_in ok" ; |
128 | is $x->total_out(), length $Answer, "total_out ok" ; |
129 | |
130 | my @Answer = split('', $Answer) ; |
131 | |
132 | my $k; |
133 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1}) ); |
134 | ok $k, "Compress::Raw::Zlib::Inflate ok" ; |
135 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
136 | |
137 | ok ! defined $k->msg(), "No error messages" ; |
138 | is $k->total_in(), 0, "total_in() == 0" ; |
139 | is $k->total_out(), 0, "total_out() == 0" ; |
140 | my $GOT = ''; |
141 | my $Z; |
142 | $Z = 1 ;#x 2000 ; |
143 | foreach (@Answer) |
144 | { |
145 | $status = $k->inflate($_, $Z) ; |
146 | $GOT .= $Z ; |
147 | last if $status == Z_STREAM_END or $status != Z_OK ; |
148 | |
149 | } |
150 | |
151 | cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; |
152 | is $GOT, $hello, "uncompressed data matches ok" ; |
153 | ok ! defined $k->msg(), "No error messages" ; |
154 | is $k->total_in(), length $Answer, "total_in ok" ; |
155 | is $k->total_out(), length $hello , "total_out ok"; |
156 | |
157 | } |
158 | |
159 | |
160 | { |
161 | # deflate/inflate - small buffer with a number |
162 | # ============================== |
163 | |
164 | my $hello = 6529 ; |
165 | |
166 | ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, -AppendOutput => 1 ) ; |
167 | ok $x ; |
168 | cmp_ok $err, '==', Z_OK ; |
169 | |
170 | my $status; |
171 | my $Answer = ''; |
172 | |
173 | cmp_ok $x->deflate($hello, $Answer), '==', Z_OK ; |
174 | |
175 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
176 | |
177 | my @Answer = split('', $Answer) ; |
178 | |
179 | my $k; |
180 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1}) ); |
181 | ok $k ; |
182 | cmp_ok $err, '==', Z_OK ; |
183 | |
184 | #my $GOT = ''; |
185 | my $GOT ; |
186 | foreach (@Answer) |
187 | { |
188 | $status = $k->inflate($_, $GOT) ; |
189 | last if $status == Z_STREAM_END or $status != Z_OK ; |
190 | |
191 | } |
192 | |
193 | cmp_ok $status, '==', Z_STREAM_END ; |
194 | is $GOT, $hello ; |
195 | |
196 | } |
197 | |
198 | { |
199 | |
200 | # deflate/inflate options - AppendOutput |
201 | # ================================ |
202 | |
203 | # AppendOutput |
204 | # CRC |
205 | |
206 | my $hello = "I am a HAL 9000 computer" ; |
207 | my @hello = split('', $hello) ; |
208 | |
209 | ok my ($x, $err) = new Compress::Raw::Zlib::Deflate ( {-Bufsize => 1, -AppendOutput =>1} ) ; |
210 | ok $x ; |
211 | cmp_ok $err, '==', Z_OK ; |
212 | |
213 | my $status; |
214 | my $X; |
215 | foreach (@hello) |
216 | { |
217 | $status = $x->deflate($_, $X) ; |
218 | last unless $status == Z_OK ; |
219 | } |
220 | |
221 | cmp_ok $status, '==', Z_OK ; |
222 | |
223 | cmp_ok $x->flush($X), '==', Z_OK ; |
224 | |
225 | |
226 | my @Answer = split('', $X) ; |
227 | |
228 | my $k; |
229 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate( {-Bufsize => 1, -AppendOutput =>1})); |
230 | ok $k ; |
231 | cmp_ok $err, '==', Z_OK ; |
232 | |
233 | my $Z; |
234 | foreach (@Answer) |
235 | { |
236 | $status = $k->inflate($_, $Z) ; |
237 | last if $status == Z_STREAM_END or $status != Z_OK ; |
238 | |
239 | } |
240 | |
241 | cmp_ok $status, '==', Z_STREAM_END ; |
242 | is $Z, $hello ; |
243 | } |
244 | |
245 | |
246 | { |
247 | |
248 | title "deflate/inflate - larger buffer"; |
249 | # ============================== |
250 | |
251 | # generate a long random string |
252 | my $contents = '' ; |
253 | foreach (1 .. 50000) |
254 | { $contents .= chr int rand 255 } |
255 | |
256 | |
257 | ok my ($x, $err) = new Compress::Raw::Zlib::Deflate() ; |
258 | ok $x ; |
259 | cmp_ok $err, '==', Z_OK ; |
260 | |
261 | my (%X, $Y, %Z, $X, $Z); |
262 | #cmp_ok $x->deflate($contents, $X{key}), '==', Z_OK ; |
263 | cmp_ok $x->deflate($contents, $X), '==', Z_OK ; |
264 | |
265 | #$Y = $X{key} ; |
266 | $Y = $X ; |
267 | |
268 | |
269 | #cmp_ok $x->flush($X{key}), '==', Z_OK ; |
270 | #$Y .= $X{key} ; |
271 | cmp_ok $x->flush($X), '==', Z_OK ; |
272 | $Y .= $X ; |
273 | |
274 | |
275 | |
276 | my $keep = $Y ; |
277 | |
278 | my $k; |
279 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate() ); |
280 | ok $k ; |
281 | cmp_ok $err, '==', Z_OK ; |
282 | |
283 | #cmp_ok $k->inflate($Y, $Z{key}), '==', Z_STREAM_END ; |
284 | #ok $contents eq $Z{key} ; |
285 | cmp_ok $k->inflate($Y, $Z), '==', Z_STREAM_END ; |
286 | ok $contents eq $Z ; |
287 | |
288 | # redo deflate with AppendOutput |
289 | |
290 | ok (($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1)) ; |
291 | ok $k ; |
292 | cmp_ok $err, '==', Z_OK ; |
293 | |
294 | my $s ; |
295 | my $out ; |
296 | my @bits = split('', $keep) ; |
297 | foreach my $bit (@bits) { |
298 | $s = $k->inflate($bit, $out) ; |
299 | } |
300 | |
301 | cmp_ok $s, '==', Z_STREAM_END ; |
302 | |
303 | ok $contents eq $out ; |
304 | |
305 | |
306 | } |
307 | |
308 | { |
309 | |
310 | title "deflate/inflate - preset dictionary"; |
311 | # =================================== |
312 | |
313 | my $dictionary = "hello" ; |
314 | ok my $x = new Compress::Raw::Zlib::Deflate({-Level => Z_BEST_COMPRESSION, |
315 | -Dictionary => $dictionary}) ; |
316 | |
317 | my $dictID = $x->dict_adler() ; |
318 | |
319 | my ($X, $Y, $Z); |
320 | cmp_ok $x->deflate($hello, $X), '==', Z_OK; |
321 | cmp_ok $x->flush($Y), '==', Z_OK; |
322 | $X .= $Y ; |
323 | |
324 | ok my $k = new Compress::Raw::Zlib::Inflate(-Dictionary => $dictionary) ; |
325 | |
326 | cmp_ok $k->inflate($X, $Z), '==', Z_STREAM_END; |
327 | is $k->dict_adler(), $dictID; |
328 | is $hello, $Z ; |
329 | |
330 | } |
331 | |
332 | title 'inflate - check remaining buffer after Z_STREAM_END'; |
333 | # and that ConsumeInput works. |
334 | # =================================================== |
335 | |
336 | for my $consume ( 0 .. 1) |
337 | { |
338 | ok my $x = new Compress::Raw::Zlib::Deflate(-Level => Z_BEST_COMPRESSION ) ; |
339 | |
340 | my ($X, $Y, $Z); |
341 | cmp_ok $x->deflate($hello, $X), '==', Z_OK; |
342 | cmp_ok $x->flush($Y), '==', Z_OK; |
343 | $X .= $Y ; |
344 | |
345 | ok my $k = new Compress::Raw::Zlib::Inflate( -ConsumeInput => $consume) ; |
346 | |
347 | my $first = substr($X, 0, 2) ; |
348 | my $remember_first = $first ; |
349 | my $last = substr($X, 2) ; |
350 | cmp_ok $k->inflate($first, $Z), '==', Z_OK; |
351 | if ($consume) { |
352 | ok $first eq "" ; |
353 | } |
354 | else { |
355 | ok $first eq $remember_first ; |
356 | } |
357 | |
358 | my $T ; |
359 | $last .= "appendage" ; |
360 | my $remember_last = $last ; |
361 | cmp_ok $k->inflate($last, $T), '==', Z_STREAM_END; |
362 | is $hello, $Z . $T ; |
363 | if ($consume) { |
364 | is $last, "appendage" ; |
365 | } |
366 | else { |
367 | is $last, $remember_last ; |
368 | } |
369 | |
370 | } |
371 | |
372 | |
373 | |
374 | { |
375 | |
376 | title 'Check - MAX_WBITS'; |
377 | # ================= |
378 | |
379 | my $hello = "Test test test test test"; |
380 | my @hello = split('', $hello) ; |
381 | |
382 | ok my ($x, $err) = |
383 | new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, |
384 | -WindowBits => -MAX_WBITS(), |
385 | -AppendOutput => 1 ) ; |
386 | ok $x ; |
387 | cmp_ok $err, '==', Z_OK ; |
388 | |
389 | my $Answer = ''; |
390 | my $status; |
391 | foreach (@hello) |
392 | { |
393 | $status = $x->deflate($_, $Answer) ; |
394 | last unless $status == Z_OK ; |
395 | } |
396 | |
397 | cmp_ok $status, '==', Z_OK ; |
398 | |
399 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
400 | |
401 | my @Answer = split('', $Answer) ; |
402 | # Undocumented corner -- extra byte needed to get inflate to return |
403 | # Z_STREAM_END when done. |
404 | push @Answer, " " ; |
405 | |
406 | my $k; |
407 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate( |
408 | {-Bufsize => 1, |
409 | -AppendOutput =>1, |
410 | -WindowBits => -MAX_WBITS()})) ; |
411 | ok $k ; |
412 | cmp_ok $err, '==', Z_OK ; |
413 | |
414 | my $GOT = ''; |
415 | foreach (@Answer) |
416 | { |
417 | $status = $k->inflate($_, $GOT) ; |
418 | last if $status == Z_STREAM_END or $status != Z_OK ; |
419 | |
420 | } |
421 | |
422 | cmp_ok $status, '==', Z_STREAM_END ; |
423 | is $GOT, $hello ; |
424 | |
425 | } |
426 | |
427 | { |
428 | title 'inflateSync'; |
429 | |
430 | # create a deflate stream with flush points |
431 | |
432 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
433 | my $goodbye = "Will I dream?" x 2010; |
434 | my ($x, $err, $answer, $X, $Z, $status); |
435 | my $Answer ; |
436 | |
437 | #use Devel::Peek ; |
438 | ok(($x, $err) = new Compress::Raw::Zlib::Deflate(AppendOutput => 1)) ; |
439 | ok $x ; |
440 | cmp_ok $err, '==', Z_OK ; |
441 | |
442 | cmp_ok $x->deflate($hello, $Answer), '==', Z_OK; |
443 | |
444 | # create a flush point |
445 | cmp_ok $x->flush($Answer, Z_FULL_FLUSH), '==', Z_OK ; |
319fab50 |
446 | |
447 | my $len1 = length $Answer; |
25f0751f |
448 | |
449 | cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK; |
450 | |
451 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
319fab50 |
452 | my $len2 = length($Answer) - $len1 ; |
25f0751f |
453 | |
454 | my ($first, @Answer) = split('', $Answer) ; |
455 | |
456 | my $k; |
457 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ; |
458 | ok $k ; |
459 | cmp_ok $err, '==', Z_OK ; |
460 | |
461 | cmp_ok $k->inflate($first, $Z), '==', Z_OK; |
462 | |
463 | # skip to the first flush point. |
464 | while (@Answer) |
465 | { |
466 | my $byte = shift @Answer; |
467 | $status = $k->inflateSync($byte) ; |
468 | last unless $status == Z_DATA_ERROR; |
469 | } |
470 | |
471 | cmp_ok $status, '==', Z_OK; |
472 | |
473 | my $GOT = ''; |
474 | foreach (@Answer) |
475 | { |
476 | my $Z = ''; |
477 | $status = $k->inflate($_, $Z) ; |
478 | $GOT .= $Z if defined $Z ; |
479 | # print "x $status\n"; |
480 | last if $status == Z_STREAM_END or $status != Z_OK ; |
25f0751f |
481 | } |
482 | |
483 | cmp_ok $status, '==', Z_DATA_ERROR ; |
484 | is $GOT, $goodbye ; |
485 | |
486 | |
487 | # Check inflateSync leaves good data in buffer |
488 | my $rest = $Answer ; |
489 | $rest =~ s/^(.)//; |
490 | my $initial = $1 ; |
491 | |
492 | |
319fab50 |
493 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(ConsumeInput => 0)) ; |
25f0751f |
494 | ok $k ; |
495 | cmp_ok $err, '==', Z_OK ; |
496 | |
497 | cmp_ok $k->inflate($initial, $Z), '==', Z_OK; |
498 | |
499 | # Skip to the flush point |
500 | $status = $k->inflateSync($rest); |
501 | cmp_ok $status, '==', Z_OK |
502 | or diag "status '$status'\nlength rest is " . length($rest) . "\n" ; |
503 | |
319fab50 |
504 | is length($rest), $len2, "expected compressed output"; |
505 | |
506 | $GOT = ''; |
507 | cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR, "inflate returns Z_DATA_ERROR"; |
508 | is $GOT, $goodbye ; |
25f0751f |
509 | } |
510 | |
511 | { |
512 | title 'deflateParams'; |
513 | |
514 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
515 | my $goodbye = "Will I dream?" x 2010; |
516 | my ($x, $input, $err, $answer, $X, $status, $Answer); |
517 | |
518 | ok(($x, $err) = new Compress::Raw::Zlib::Deflate( |
519 | -AppendOutput => 1, |
520 | -Level => Z_DEFAULT_COMPRESSION, |
521 | -Strategy => Z_DEFAULT_STRATEGY)) ; |
522 | ok $x ; |
523 | cmp_ok $err, '==', Z_OK ; |
524 | |
525 | ok $x->get_Level() == Z_DEFAULT_COMPRESSION; |
526 | ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; |
527 | |
528 | $status = $x->deflate($hello, $Answer) ; |
529 | cmp_ok $status, '==', Z_OK ; |
530 | $input .= $hello; |
531 | |
532 | # error cases |
533 | eval { $x->deflateParams() }; |
534 | like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy'); |
535 | |
536 | eval { $x->deflateParams(-Bufsize => 0) }; |
537 | like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0'); |
538 | |
539 | eval { $x->deflateParams(-Joe => 3) }; |
540 | like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe'); |
541 | |
542 | is $x->get_Level(), Z_DEFAULT_COMPRESSION; |
543 | is $x->get_Strategy(), Z_DEFAULT_STRATEGY; |
544 | |
545 | # change both Level & Strategy |
546 | $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ; |
547 | cmp_ok $status, '==', Z_OK ; |
548 | |
549 | is $x->get_Level(), Z_BEST_SPEED; |
550 | is $x->get_Strategy(), Z_HUFFMAN_ONLY; |
551 | |
552 | $status = $x->deflate($goodbye, $Answer) ; |
553 | cmp_ok $status, '==', Z_OK ; |
554 | $input .= $goodbye; |
555 | |
556 | # change only Level |
557 | $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ; |
558 | cmp_ok $status, '==', Z_OK ; |
559 | |
560 | is $x->get_Level(), Z_NO_COMPRESSION; |
561 | is $x->get_Strategy(), Z_HUFFMAN_ONLY; |
562 | |
563 | $status = $x->deflate($goodbye, $Answer) ; |
564 | cmp_ok $status, '==', Z_OK ; |
565 | $input .= $goodbye; |
566 | |
567 | # change only Strategy |
568 | $status = $x->deflateParams(-Strategy => Z_FILTERED) ; |
569 | cmp_ok $status, '==', Z_OK ; |
570 | |
571 | is $x->get_Level(), Z_NO_COMPRESSION; |
572 | is $x->get_Strategy(), Z_FILTERED; |
573 | |
574 | $status = $x->deflate($goodbye, $Answer) ; |
575 | cmp_ok $status, '==', Z_OK ; |
576 | $input .= $goodbye; |
577 | |
578 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
579 | |
580 | my $k; |
581 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ; |
582 | ok $k ; |
583 | cmp_ok $err, '==', Z_OK ; |
584 | |
585 | my $Z; |
586 | $status = $k->inflate($Answer, $Z) ; |
587 | |
588 | cmp_ok $status, '==', Z_STREAM_END ; |
589 | is $Z, $input ; |
590 | } |
591 | |
592 | |
593 | { |
594 | title "ConsumeInput and a read-only buffer trapped" ; |
595 | |
596 | ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ; |
597 | |
598 | my $Z; |
599 | eval { $k->inflate("abc", $Z) ; }; |
600 | like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified"); |
601 | |
602 | } |
603 | |
604 | foreach (1 .. 2) |
605 | { |
606 | next if $[ < 5.005 ; |
607 | |
608 | title 'test inflate/deflate with a substr'; |
609 | |
610 | my $contents = '' ; |
611 | foreach (1 .. 5000) |
612 | { $contents .= chr int rand 255 } |
613 | ok my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ; |
614 | |
615 | my $X ; |
616 | my $status = $x->deflate(substr($contents,0), $X); |
617 | cmp_ok $status, '==', Z_OK ; |
618 | |
619 | cmp_ok $x->flush($X), '==', Z_OK ; |
620 | |
621 | my $append = "Appended" ; |
622 | $X .= $append ; |
623 | |
624 | ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ; |
625 | |
626 | my $Z; |
627 | my $keep = $X ; |
628 | $status = $k->inflate(substr($X, 0), $Z) ; |
629 | |
630 | cmp_ok $status, '==', Z_STREAM_END ; |
631 | #print "status $status X [$X]\n" ; |
632 | is $contents, $Z ; |
633 | ok $X eq $append; |
634 | #is length($X), length($append); |
635 | #ok $X eq $keep; |
636 | #is length($X), length($keep); |
637 | } |
638 | |
639 | title 'Looping Append test - checks that deRef_l resets the output buffer'; |
640 | foreach (1 .. 2) |
641 | { |
642 | |
643 | my $hello = "I am a HAL 9000 computer" ; |
644 | my @hello = split('', $hello) ; |
645 | my ($err, $x, $X, $status); |
646 | |
647 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) ); |
648 | ok $x ; |
649 | cmp_ok $err, '==', Z_OK ; |
650 | |
651 | $X = "" ; |
652 | my $Answer = ''; |
653 | foreach (@hello) |
654 | { |
655 | $status = $x->deflate($_, $X) ; |
656 | last unless $status == Z_OK ; |
657 | |
658 | $Answer .= $X ; |
659 | } |
660 | |
661 | cmp_ok $status, '==', Z_OK ; |
662 | |
663 | cmp_ok $x->flush($X), '==', Z_OK ; |
664 | $Answer .= $X ; |
665 | |
666 | my @Answer = split('', $Answer) ; |
667 | |
668 | my $k; |
669 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
670 | ok $k ; |
671 | cmp_ok $err, '==', Z_OK ; |
672 | |
673 | my $GOT ; |
674 | my $Z; |
675 | $Z = 1 ;#x 2000 ; |
676 | foreach (@Answer) |
677 | { |
678 | $status = $k->inflate($_, $GOT) ; |
679 | last if $status == Z_STREAM_END or $status != Z_OK ; |
680 | } |
681 | |
682 | cmp_ok $status, '==', Z_STREAM_END ; |
683 | is $GOT, $hello ; |
684 | |
685 | } |
686 | |
687 | if ($] >= 5.005) |
688 | { |
689 | title 'test inflate input parameter via substr'; |
690 | |
691 | my $hello = "I am a HAL 9000 computer" ; |
692 | my $data = $hello ; |
693 | |
694 | my($X, $Z); |
695 | |
696 | ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 ); |
697 | |
698 | cmp_ok $x->deflate($data, $X), '==', Z_OK ; |
699 | |
700 | cmp_ok $x->flush($X), '==', Z_OK ; |
701 | |
702 | my $append = "Appended" ; |
703 | $X .= $append ; |
704 | my $keep = $X ; |
705 | |
706 | ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1, |
707 | -ConsumeInput => 1 ) ; |
708 | |
4e7676c7 |
709 | cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ; |
25f0751f |
710 | |
711 | ok $hello eq $Z ; |
712 | is $X, $append; |
713 | |
714 | $X = $keep ; |
715 | $Z = ''; |
716 | ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1, |
717 | -ConsumeInput => 0 ) ; |
718 | |
719 | cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ; |
720 | #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ; |
721 | |
722 | ok $hello eq $Z ; |
723 | is $X, $keep; |
724 | |
725 | } |
726 | |
cb7abd7f |
727 | { |
728 | # regression - check that resetLastBlockByte can cope with a NULL |
729 | # pointer. |
730 | Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef); |
731 | ok 1, "resetLastBlockByte(undef) is ok" ; |
732 | } |
733 | |
e11a3f9e |
734 | { |
735 | |
736 | title "gzip mode"; |
737 | # ================ |
738 | |
739 | my $hello = "I am a HAL 9000 computer" ; |
740 | my @hello = split('', $hello) ; |
741 | my ($err, $x, $X, $status); |
742 | |
743 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( |
744 | WindowBits => WANT_GZIP , |
745 | AppendOutput => 1 |
746 | ), "Create deflate object" ); |
747 | ok $x, "Compress::Raw::Zlib::Deflate ok" ; |
748 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
749 | |
750 | $status = $x->deflate($hello, $X) ; |
751 | cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; |
752 | |
753 | cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ; |
754 | |
755 | my ($k, $GOT); |
756 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
757 | WindowBits => WANT_GZIP , |
758 | ConsumeInput => 0 , |
759 | AppendOutput => 1); |
760 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ; |
761 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
762 | |
763 | $status = $k->inflate($X, $GOT) ; |
764 | cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; |
765 | is $GOT, $hello, "uncompressed data matches ok" ; |
766 | |
767 | $GOT = ''; |
768 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
769 | WindowBits => WANT_GZIP_OR_ZLIB , |
770 | AppendOutput => 1); |
771 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ; |
772 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
773 | |
774 | $status = $k->inflate($X, $GOT) ; |
775 | cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; |
776 | is $GOT, $hello, "uncompressed data matches ok" ; |
777 | } |
778 | |
779 | { |
780 | |
781 | title "gzip error mode"; |
782 | # Create gzip - |
783 | # read with no special windowbits setting - this will fail |
784 | # then read with WANT_GZIP_OR_ZLIB - thi swill work |
785 | # ================ |
786 | |
787 | my $hello = "I am a HAL 9000 computer" ; |
788 | my ($err, $x, $X, $status); |
789 | |
790 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( |
791 | WindowBits => WANT_GZIP , |
792 | AppendOutput => 1 |
793 | ), "Create deflate object" ); |
794 | ok $x, "Compress::Raw::Zlib::Deflate ok" ; |
795 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
796 | |
797 | $status = $x->deflate($hello, $X) ; |
798 | cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; |
799 | |
800 | cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ; |
801 | |
802 | my ($k, $GOT); |
803 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
804 | WindowBits => MAX_WBITS , |
805 | ConsumeInput => 0 , |
806 | AppendOutput => 1); |
807 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ; |
808 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
809 | |
810 | $status = $k->inflate($X, $GOT) ; |
811 | cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ; |
812 | |
813 | $GOT = ''; |
814 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
815 | WindowBits => WANT_GZIP_OR_ZLIB , |
816 | AppendOutput => 1); |
817 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ; |
818 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
819 | |
820 | $status = $k->inflate($X, $GOT) ; |
821 | cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; |
822 | is $GOT, $hello, "uncompressed data matches ok" ; |
823 | } |
824 | |
825 | { |
826 | |
827 | title "gzip/zlib error mode"; |
828 | # Create zlib - |
829 | # read with no WANT_GZIP windowbits setting - this will fail |
830 | # then read with WANT_GZIP_OR_ZLIB - thi swill work |
831 | # ================ |
832 | |
833 | my $hello = "I am a HAL 9000 computer" ; |
834 | my ($err, $x, $X, $status); |
835 | |
836 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( |
837 | AppendOutput => 1 |
838 | ), "Create deflate object" ); |
839 | ok $x, "Compress::Raw::Zlib::Deflate ok" ; |
840 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
841 | |
842 | $status = $x->deflate($hello, $X) ; |
843 | cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; |
844 | |
845 | cmp_ok $x->flush($X), '==', Z_OK, "flush returned Z_OK" ; |
846 | |
847 | my ($k, $GOT); |
848 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
849 | WindowBits => WANT_GZIP , |
850 | ConsumeInput => 0 , |
851 | AppendOutput => 1); |
852 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP ok" ; |
853 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
854 | |
855 | $status = $k->inflate($X, $GOT) ; |
856 | cmp_ok $status, '==', Z_DATA_ERROR, "Got Z_DATA_ERROR" ; |
857 | |
858 | $GOT = ''; |
859 | ($k, $err) = new Compress::Raw::Zlib::Inflate( |
860 | WindowBits => WANT_GZIP_OR_ZLIB , |
861 | AppendOutput => 1); |
862 | ok $k, "Compress::Raw::Zlib::Inflate WANT_GZIP_OR_ZLIB ok" ; |
863 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; |
864 | |
865 | $status = $k->inflate($X, $GOT) ; |
866 | cmp_ok $status, '==', Z_STREAM_END, "Got Z_STREAM_END" ; |
867 | is $GOT, $hello, "uncompressed data matches ok" ; |
868 | } |
869 | |
25f0751f |
870 | exit if $] < 5.006 ; |
871 | |
872 | title 'Looping Append test with substr output - substr the end of the string'; |
873 | foreach (1 .. 2) |
874 | { |
875 | |
876 | my $hello = "I am a HAL 9000 computer" ; |
877 | my @hello = split('', $hello) ; |
878 | my ($err, $x, $X, $status); |
879 | |
880 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, |
881 | -AppendOutput => 1 ) ); |
882 | ok $x ; |
883 | cmp_ok $err, '==', Z_OK ; |
884 | |
885 | $X = "" ; |
886 | my $Answer = ''; |
887 | foreach (@hello) |
888 | { |
889 | $status = $x->deflate($_, substr($Answer, length($Answer))) ; |
890 | last unless $status == Z_OK ; |
891 | |
892 | } |
893 | |
894 | cmp_ok $status, '==', Z_OK ; |
895 | |
896 | cmp_ok $x->flush(substr($Answer, length($Answer))), '==', Z_OK ; |
897 | |
4e7676c7 |
898 | #cmp_ok length $Answer, ">", 0 ; |
899 | |
25f0751f |
900 | my @Answer = split('', $Answer) ; |
4e7676c7 |
901 | |
25f0751f |
902 | |
903 | my $k; |
904 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
905 | ok $k ; |
906 | cmp_ok $err, '==', Z_OK ; |
907 | |
908 | my $GOT = ''; |
909 | my $Z; |
910 | $Z = 1 ;#x 2000 ; |
911 | foreach (@Answer) |
912 | { |
913 | $status = $k->inflate($_, substr($GOT, length($GOT))) ; |
914 | last if $status == Z_STREAM_END or $status != Z_OK ; |
915 | } |
916 | |
917 | cmp_ok $status, '==', Z_STREAM_END ; |
918 | is $GOT, $hello ; |
919 | |
920 | } |
921 | |
922 | title 'Looping Append test with substr output - substr the complete string'; |
923 | foreach (1 .. 2) |
924 | { |
925 | |
926 | my $hello = "I am a HAL 9000 computer" ; |
927 | my @hello = split('', $hello) ; |
928 | my ($err, $x, $X, $status); |
929 | |
930 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, |
931 | -AppendOutput => 1 ) ); |
932 | ok $x ; |
933 | cmp_ok $err, '==', Z_OK ; |
934 | |
935 | $X = "" ; |
936 | my $Answer = ''; |
937 | foreach (@hello) |
938 | { |
939 | $status = $x->deflate($_, substr($Answer, 0)) ; |
940 | last unless $status == Z_OK ; |
941 | |
942 | } |
943 | |
944 | cmp_ok $status, '==', Z_OK ; |
945 | |
946 | cmp_ok $x->flush(substr($Answer, 0)), '==', Z_OK ; |
947 | |
948 | my @Answer = split('', $Answer) ; |
949 | |
950 | my $k; |
951 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
952 | ok $k ; |
953 | cmp_ok $err, '==', Z_OK ; |
954 | |
955 | my $GOT = ''; |
956 | my $Z; |
957 | $Z = 1 ;#x 2000 ; |
958 | foreach (@Answer) |
959 | { |
960 | $status = $k->inflate($_, substr($GOT, 0)) ; |
961 | last if $status == Z_STREAM_END or $status != Z_OK ; |
962 | } |
963 | |
964 | cmp_ok $status, '==', Z_STREAM_END ; |
965 | is $GOT, $hello ; |
966 | } |
967 | |