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