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) { |
cb7abd7f |
27 | $count = 189 ; |
25f0751f |
28 | } |
29 | elsif ($] >= 5.006) { |
cb7abd7f |
30 | $count = 243 ; |
25f0751f |
31 | } |
32 | else { |
cb7abd7f |
33 | $count = 201 ; |
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 ; |
446 | |
447 | cmp_ok $x->deflate($goodbye, $Answer), '==', Z_OK; |
448 | |
449 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
450 | |
451 | my ($first, @Answer) = split('', $Answer) ; |
452 | |
453 | my $k; |
454 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ; |
455 | ok $k ; |
456 | cmp_ok $err, '==', Z_OK ; |
457 | |
458 | cmp_ok $k->inflate($first, $Z), '==', Z_OK; |
459 | |
460 | # skip to the first flush point. |
461 | while (@Answer) |
462 | { |
463 | my $byte = shift @Answer; |
464 | $status = $k->inflateSync($byte) ; |
465 | last unless $status == Z_DATA_ERROR; |
466 | } |
467 | |
468 | cmp_ok $status, '==', Z_OK; |
469 | |
470 | my $GOT = ''; |
471 | foreach (@Answer) |
472 | { |
473 | my $Z = ''; |
474 | $status = $k->inflate($_, $Z) ; |
475 | $GOT .= $Z if defined $Z ; |
476 | # print "x $status\n"; |
477 | last if $status == Z_STREAM_END or $status != Z_OK ; |
478 | |
479 | } |
480 | |
481 | cmp_ok $status, '==', Z_DATA_ERROR ; |
482 | is $GOT, $goodbye ; |
483 | |
484 | |
485 | # Check inflateSync leaves good data in buffer |
486 | my $rest = $Answer ; |
487 | $rest =~ s/^(.)//; |
488 | my $initial = $1 ; |
489 | |
490 | |
491 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 0)) ; |
492 | ok $k ; |
493 | cmp_ok $err, '==', Z_OK ; |
494 | |
495 | cmp_ok $k->inflate($initial, $Z), '==', Z_OK; |
496 | |
497 | # Skip to the flush point |
498 | $status = $k->inflateSync($rest); |
499 | cmp_ok $status, '==', Z_OK |
500 | or diag "status '$status'\nlength rest is " . length($rest) . "\n" ; |
501 | |
502 | cmp_ok $k->inflate($rest, $GOT), '==', Z_DATA_ERROR; |
503 | is $Z . $GOT, $goodbye ; |
504 | } |
505 | |
506 | { |
507 | title 'deflateParams'; |
508 | |
509 | my $hello = "I am a HAL 9000 computer" x 2001 ; |
510 | my $goodbye = "Will I dream?" x 2010; |
511 | my ($x, $input, $err, $answer, $X, $status, $Answer); |
512 | |
513 | ok(($x, $err) = new Compress::Raw::Zlib::Deflate( |
514 | -AppendOutput => 1, |
515 | -Level => Z_DEFAULT_COMPRESSION, |
516 | -Strategy => Z_DEFAULT_STRATEGY)) ; |
517 | ok $x ; |
518 | cmp_ok $err, '==', Z_OK ; |
519 | |
520 | ok $x->get_Level() == Z_DEFAULT_COMPRESSION; |
521 | ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; |
522 | |
523 | $status = $x->deflate($hello, $Answer) ; |
524 | cmp_ok $status, '==', Z_OK ; |
525 | $input .= $hello; |
526 | |
527 | # error cases |
528 | eval { $x->deflateParams() }; |
529 | like $@, mkErr('^Compress::Raw::Zlib::deflateParams needs Level and\/or Strategy'); |
530 | |
531 | eval { $x->deflateParams(-Bufsize => 0) }; |
532 | like $@, mkErr('^Compress::Raw::Zlib::Inflate::deflateParams: Bufsize must be >= 1, you specified 0'); |
533 | |
534 | eval { $x->deflateParams(-Joe => 3) }; |
535 | like $@, mkErr('^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe'); |
536 | |
537 | is $x->get_Level(), Z_DEFAULT_COMPRESSION; |
538 | is $x->get_Strategy(), Z_DEFAULT_STRATEGY; |
539 | |
540 | # change both Level & Strategy |
541 | $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY, -Bufsize => 1234) ; |
542 | cmp_ok $status, '==', Z_OK ; |
543 | |
544 | is $x->get_Level(), Z_BEST_SPEED; |
545 | is $x->get_Strategy(), Z_HUFFMAN_ONLY; |
546 | |
547 | $status = $x->deflate($goodbye, $Answer) ; |
548 | cmp_ok $status, '==', Z_OK ; |
549 | $input .= $goodbye; |
550 | |
551 | # change only Level |
552 | $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ; |
553 | cmp_ok $status, '==', Z_OK ; |
554 | |
555 | is $x->get_Level(), Z_NO_COMPRESSION; |
556 | is $x->get_Strategy(), Z_HUFFMAN_ONLY; |
557 | |
558 | $status = $x->deflate($goodbye, $Answer) ; |
559 | cmp_ok $status, '==', Z_OK ; |
560 | $input .= $goodbye; |
561 | |
562 | # change only Strategy |
563 | $status = $x->deflateParams(-Strategy => Z_FILTERED) ; |
564 | cmp_ok $status, '==', Z_OK ; |
565 | |
566 | is $x->get_Level(), Z_NO_COMPRESSION; |
567 | is $x->get_Strategy(), Z_FILTERED; |
568 | |
569 | $status = $x->deflate($goodbye, $Answer) ; |
570 | cmp_ok $status, '==', Z_OK ; |
571 | $input .= $goodbye; |
572 | |
573 | cmp_ok $x->flush($Answer), '==', Z_OK ; |
574 | |
575 | my $k; |
576 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate()) ; |
577 | ok $k ; |
578 | cmp_ok $err, '==', Z_OK ; |
579 | |
580 | my $Z; |
581 | $status = $k->inflate($Answer, $Z) ; |
582 | |
583 | cmp_ok $status, '==', Z_STREAM_END ; |
584 | is $Z, $input ; |
585 | } |
586 | |
587 | |
588 | { |
589 | title "ConsumeInput and a read-only buffer trapped" ; |
590 | |
591 | ok my $k = new Compress::Raw::Zlib::Inflate(-ConsumeInput => 1) ; |
592 | |
593 | my $Z; |
594 | eval { $k->inflate("abc", $Z) ; }; |
595 | like $@, mkErr("Compress::Raw::Zlib::Inflate::inflate input parameter cannot be read-only when ConsumeInput is specified"); |
596 | |
597 | } |
598 | |
599 | foreach (1 .. 2) |
600 | { |
601 | next if $[ < 5.005 ; |
602 | |
603 | title 'test inflate/deflate with a substr'; |
604 | |
605 | my $contents = '' ; |
606 | foreach (1 .. 5000) |
607 | { $contents .= chr int rand 255 } |
608 | ok my $x = new Compress::Raw::Zlib::Deflate(-AppendOutput => 1) ; |
609 | |
610 | my $X ; |
611 | my $status = $x->deflate(substr($contents,0), $X); |
612 | cmp_ok $status, '==', Z_OK ; |
613 | |
614 | cmp_ok $x->flush($X), '==', Z_OK ; |
615 | |
616 | my $append = "Appended" ; |
617 | $X .= $append ; |
618 | |
619 | ok my $k = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ; |
620 | |
621 | my $Z; |
622 | my $keep = $X ; |
623 | $status = $k->inflate(substr($X, 0), $Z) ; |
624 | |
625 | cmp_ok $status, '==', Z_STREAM_END ; |
626 | #print "status $status X [$X]\n" ; |
627 | is $contents, $Z ; |
628 | ok $X eq $append; |
629 | #is length($X), length($append); |
630 | #ok $X eq $keep; |
631 | #is length($X), length($keep); |
632 | } |
633 | |
634 | title 'Looping Append test - checks that deRef_l resets the output buffer'; |
635 | foreach (1 .. 2) |
636 | { |
637 | |
638 | my $hello = "I am a HAL 9000 computer" ; |
639 | my @hello = split('', $hello) ; |
640 | my ($err, $x, $X, $status); |
641 | |
642 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1 ) ); |
643 | ok $x ; |
644 | cmp_ok $err, '==', Z_OK ; |
645 | |
646 | $X = "" ; |
647 | my $Answer = ''; |
648 | foreach (@hello) |
649 | { |
650 | $status = $x->deflate($_, $X) ; |
651 | last unless $status == Z_OK ; |
652 | |
653 | $Answer .= $X ; |
654 | } |
655 | |
656 | cmp_ok $status, '==', Z_OK ; |
657 | |
658 | cmp_ok $x->flush($X), '==', Z_OK ; |
659 | $Answer .= $X ; |
660 | |
661 | my @Answer = split('', $Answer) ; |
662 | |
663 | my $k; |
664 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
665 | ok $k ; |
666 | cmp_ok $err, '==', Z_OK ; |
667 | |
668 | my $GOT ; |
669 | my $Z; |
670 | $Z = 1 ;#x 2000 ; |
671 | foreach (@Answer) |
672 | { |
673 | $status = $k->inflate($_, $GOT) ; |
674 | last if $status == Z_STREAM_END or $status != Z_OK ; |
675 | } |
676 | |
677 | cmp_ok $status, '==', Z_STREAM_END ; |
678 | is $GOT, $hello ; |
679 | |
680 | } |
681 | |
682 | if ($] >= 5.005) |
683 | { |
684 | title 'test inflate input parameter via substr'; |
685 | |
686 | my $hello = "I am a HAL 9000 computer" ; |
687 | my $data = $hello ; |
688 | |
689 | my($X, $Z); |
690 | |
691 | ok my $x = new Compress::Raw::Zlib::Deflate ( -AppendOutput => 1 ); |
692 | |
693 | cmp_ok $x->deflate($data, $X), '==', Z_OK ; |
694 | |
695 | cmp_ok $x->flush($X), '==', Z_OK ; |
696 | |
697 | my $append = "Appended" ; |
698 | $X .= $append ; |
699 | my $keep = $X ; |
700 | |
701 | ok my $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1, |
702 | -ConsumeInput => 1 ) ; |
703 | |
704 | # cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ; |
705 | cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ; |
706 | |
707 | ok $hello eq $Z ; |
708 | is $X, $append; |
709 | |
710 | $X = $keep ; |
711 | $Z = ''; |
712 | ok $k = new Compress::Raw::Zlib::Inflate ( -AppendOutput => 1, |
713 | -ConsumeInput => 0 ) ; |
714 | |
715 | cmp_ok $k->inflate(substr($X, 0, -1), $Z), '==', Z_STREAM_END ; ; |
716 | #cmp_ok $k->inflate(substr($X, 0), $Z), '==', Z_STREAM_END ; ; |
717 | |
718 | ok $hello eq $Z ; |
719 | is $X, $keep; |
720 | |
721 | } |
722 | |
cb7abd7f |
723 | { |
724 | # regression - check that resetLastBlockByte can cope with a NULL |
725 | # pointer. |
726 | Compress::Raw::Zlib::InflateScan->new->resetLastBlockByte(undef); |
727 | ok 1, "resetLastBlockByte(undef) is ok" ; |
728 | } |
729 | |
25f0751f |
730 | exit if $] < 5.006 ; |
731 | |
732 | title 'Looping Append test with substr output - substr the end of the string'; |
733 | foreach (1 .. 2) |
734 | { |
735 | |
736 | my $hello = "I am a HAL 9000 computer" ; |
737 | my @hello = split('', $hello) ; |
738 | my ($err, $x, $X, $status); |
739 | |
740 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, |
741 | -AppendOutput => 1 ) ); |
742 | ok $x ; |
743 | cmp_ok $err, '==', Z_OK ; |
744 | |
745 | $X = "" ; |
746 | my $Answer = ''; |
747 | foreach (@hello) |
748 | { |
749 | $status = $x->deflate($_, substr($Answer, length($Answer))) ; |
750 | last unless $status == Z_OK ; |
751 | |
752 | } |
753 | |
754 | cmp_ok $status, '==', Z_OK ; |
755 | |
756 | cmp_ok $x->flush(substr($Answer, length($Answer))), '==', Z_OK ; |
757 | |
758 | my @Answer = split('', $Answer) ; |
759 | |
760 | my $k; |
761 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
762 | ok $k ; |
763 | cmp_ok $err, '==', Z_OK ; |
764 | |
765 | my $GOT = ''; |
766 | my $Z; |
767 | $Z = 1 ;#x 2000 ; |
768 | foreach (@Answer) |
769 | { |
770 | $status = $k->inflate($_, substr($GOT, length($GOT))) ; |
771 | last if $status == Z_STREAM_END or $status != Z_OK ; |
772 | } |
773 | |
774 | cmp_ok $status, '==', Z_STREAM_END ; |
775 | is $GOT, $hello ; |
776 | |
777 | } |
778 | |
779 | title 'Looping Append test with substr output - substr the complete string'; |
780 | foreach (1 .. 2) |
781 | { |
782 | |
783 | my $hello = "I am a HAL 9000 computer" ; |
784 | my @hello = split('', $hello) ; |
785 | my ($err, $x, $X, $status); |
786 | |
787 | ok( ($x, $err) = new Compress::Raw::Zlib::Deflate ( -Bufsize => 1, |
788 | -AppendOutput => 1 ) ); |
789 | ok $x ; |
790 | cmp_ok $err, '==', Z_OK ; |
791 | |
792 | $X = "" ; |
793 | my $Answer = ''; |
794 | foreach (@hello) |
795 | { |
796 | $status = $x->deflate($_, substr($Answer, 0)) ; |
797 | last unless $status == Z_OK ; |
798 | |
799 | } |
800 | |
801 | cmp_ok $status, '==', Z_OK ; |
802 | |
803 | cmp_ok $x->flush(substr($Answer, 0)), '==', Z_OK ; |
804 | |
805 | my @Answer = split('', $Answer) ; |
806 | |
807 | my $k; |
808 | ok(($k, $err) = new Compress::Raw::Zlib::Inflate(-AppendOutput => 1) ); |
809 | ok $k ; |
810 | cmp_ok $err, '==', Z_OK ; |
811 | |
812 | my $GOT = ''; |
813 | my $Z; |
814 | $Z = 1 ;#x 2000 ; |
815 | foreach (@Answer) |
816 | { |
817 | $status = $k->inflate($_, substr($GOT, 0)) ; |
818 | last if $status == Z_STREAM_END or $status != Z_OK ; |
819 | } |
820 | |
821 | cmp_ok $status, '==', Z_STREAM_END ; |
822 | is $GOT, $hello ; |
823 | } |
824 | |