Commit | Line | Data |
---|---|---|
d5e5b609 SH |
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 | 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) { | |
422d6414 | 26 | $count = 453 ; |
d5e5b609 SH |
27 | } |
28 | else { | |
8341ee1e | 29 | $count = 471 ; |
d5e5b609 SH |
30 | } |
31 | ||
32 | ||
33 | plan tests => $count + $extra ; | |
34 | ||
9b5fd1d4 | 35 | use_ok('Compress::Zlib', qw(:ALL memGunzip memGzip zlib_version)); |
d5e5b609 SH |
36 | use_ok('IO::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. | |
e8796d61 CBW |
50 | SKIP: { |
51 | skip "TEST_SKIP_VERSION_CHECK is set", 1 | |
52 | if $ENV{TEST_SKIP_VERSION_CHECK}; | |
53 | is Compress::Zlib::zlib_version, ZLIB_VERSION, | |
54 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; | |
55 | } | |
d5e5b609 SH |
56 | |
57 | # generate a long random string | |
58 | my $contents = '' ; | |
59 | foreach (1 .. 5000) | |
60 | { $contents .= chr int rand 256 } | |
61 | ||
62 | my $x ; | |
63 | my $fil; | |
64 | ||
65 | # compress/uncompress tests | |
66 | # ========================= | |
67 | ||
68 | eval { compress([1]); }; | |
69 | ok $@ =~ m#not a scalar reference# | |
70 | or print "# $@\n" ;; | |
71 | ||
72 | eval { uncompress([1]); }; | |
73 | ok $@ =~ m#not a scalar reference# | |
74 | or print "# $@\n" ;; | |
75 | ||
76 | $hello = "hello mum" ; | |
77 | my $keep_hello = $hello ; | |
78 | ||
79 | my $compr = compress($hello) ; | |
80 | ok $compr ne "" ; | |
81 | ||
82 | my $keep_compr = $compr ; | |
83 | ||
84 | my $uncompr = uncompress ($compr) ; | |
85 | ||
86 | ok $hello eq $uncompr ; | |
87 | ||
88 | ok $hello eq $keep_hello ; | |
89 | ok $compr eq $keep_compr ; | |
90 | ||
91 | # compress a number | |
92 | $hello = 7890 ; | |
93 | $keep_hello = $hello ; | |
94 | ||
95 | $compr = compress($hello) ; | |
96 | ok $compr ne "" ; | |
97 | ||
98 | $keep_compr = $compr ; | |
99 | ||
100 | $uncompr = uncompress ($compr) ; | |
101 | ||
102 | ok $hello eq $uncompr ; | |
103 | ||
104 | ok $hello eq $keep_hello ; | |
105 | ok $compr eq $keep_compr ; | |
106 | ||
107 | # bigger compress | |
108 | ||
109 | $compr = compress ($contents) ; | |
110 | ok $compr ne "" ; | |
111 | ||
112 | $uncompr = uncompress ($compr) ; | |
113 | ||
114 | ok $contents eq $uncompr ; | |
115 | ||
116 | # buffer reference | |
117 | ||
118 | $compr = compress(\$hello) ; | |
119 | ok $compr ne "" ; | |
120 | ||
121 | ||
122 | $uncompr = uncompress (\$compr) ; | |
123 | ok $hello eq $uncompr ; | |
124 | ||
125 | # bad level | |
126 | $compr = compress($hello, 1000) ; | |
127 | ok ! defined $compr; | |
128 | ||
129 | # change level | |
130 | $compr = compress($hello, Z_BEST_COMPRESSION) ; | |
131 | ok defined $compr; | |
132 | $uncompr = uncompress (\$compr) ; | |
133 | ok $hello eq $uncompr ; | |
134 | ||
135 | # corrupt data | |
136 | $compr = compress(\$hello) ; | |
137 | ok $compr ne "" ; | |
138 | ||
139 | substr($compr,0, 1) = "\xFF"; | |
140 | ok !defined uncompress (\$compr) ; | |
141 | ||
142 | # deflate/inflate - small buffer | |
143 | # ============================== | |
144 | ||
145 | $hello = "I am a HAL 9000 computer" ; | |
146 | my @hello = split('', $hello) ; | |
147 | my ($err, $X, $status); | |
148 | ||
149 | ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; | |
150 | ok $x ; | |
151 | ok $err == Z_OK ; | |
152 | ||
153 | my $Answer = ''; | |
154 | foreach (@hello) | |
155 | { | |
156 | ($X, $status) = $x->deflate($_) ; | |
157 | last unless $status == Z_OK ; | |
158 | ||
159 | $Answer .= $X ; | |
160 | } | |
161 | ||
162 | ok $status == Z_OK ; | |
163 | ||
164 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; | |
165 | $Answer .= $X ; | |
166 | ||
167 | ||
168 | my @Answer = split('', $Answer) ; | |
169 | ||
170 | my $k; | |
171 | ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; | |
172 | ok $k ; | |
173 | ok $err == Z_OK ; | |
174 | ||
175 | my $GOT = ''; | |
176 | my $Z; | |
177 | foreach (@Answer) | |
178 | { | |
179 | ($Z, $status) = $k->inflate($_) ; | |
180 | $GOT .= $Z ; | |
181 | last if $status == Z_STREAM_END or $status != Z_OK ; | |
182 | ||
183 | } | |
184 | ||
185 | ok $status == Z_STREAM_END ; | |
186 | ok $GOT eq $hello ; | |
187 | ||
188 | ||
189 | title 'deflate/inflate - small buffer with a number'; | |
190 | # ============================== | |
191 | ||
192 | $hello = 6529 ; | |
193 | ||
194 | ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ; | |
195 | ok $x ; | |
196 | ok $err == Z_OK ; | |
197 | ||
198 | ok !defined $x->msg() ; | |
199 | ok $x->total_in() == 0 ; | |
200 | ok $x->total_out() == 0 ; | |
201 | $Answer = ''; | |
202 | { | |
203 | ($X, $status) = $x->deflate($hello) ; | |
204 | ||
205 | $Answer .= $X ; | |
206 | } | |
207 | ||
208 | ok $status == Z_OK ; | |
209 | ||
210 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; | |
211 | $Answer .= $X ; | |
212 | ||
213 | ok !defined $x->msg() ; | |
214 | ok $x->total_in() == length $hello ; | |
215 | ok $x->total_out() == length $Answer ; | |
216 | ||
217 | ||
218 | @Answer = split('', $Answer) ; | |
219 | ||
220 | ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ; | |
221 | ok $k ; | |
222 | ok $err == Z_OK ; | |
223 | ||
224 | ok !defined $k->msg() ; | |
225 | ok $k->total_in() == 0 ; | |
226 | ok $k->total_out() == 0 ; | |
227 | ||
228 | $GOT = ''; | |
229 | foreach (@Answer) | |
230 | { | |
231 | ($Z, $status) = $k->inflate($_) ; | |
232 | $GOT .= $Z ; | |
233 | last if $status == Z_STREAM_END or $status != Z_OK ; | |
234 | ||
235 | } | |
236 | ||
237 | ok $status == Z_STREAM_END ; | |
238 | ok $GOT eq $hello ; | |
239 | ||
240 | ok !defined $k->msg() ; | |
241 | is $k->total_in(), length $Answer ; | |
242 | ok $k->total_out() == length $hello ; | |
243 | ||
244 | ||
245 | ||
246 | title 'deflate/inflate - larger buffer'; | |
247 | # ============================== | |
248 | ||
249 | ||
250 | ok $x = deflateInit() ; | |
251 | ||
252 | ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ; | |
253 | ||
254 | my $Y = $X ; | |
255 | ||
256 | ||
257 | ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; | |
258 | $Y .= $X ; | |
259 | ||
260 | ||
261 | ||
262 | ok $k = inflateInit() ; | |
263 | ||
264 | ($Z, $status) = $k->inflate($Y) ; | |
265 | ||
266 | ok $status == Z_STREAM_END ; | |
267 | ok $contents eq $Z ; | |
268 | ||
269 | title 'deflate/inflate - preset dictionary'; | |
270 | # =================================== | |
271 | ||
272 | my $dictionary = "hello" ; | |
273 | ok $x = deflateInit({-Level => Z_BEST_COMPRESSION, | |
274 | -Dictionary => $dictionary}) ; | |
275 | ||
276 | my $dictID = $x->dict_adler() ; | |
277 | ||
278 | ($X, $status) = $x->deflate($hello) ; | |
279 | ok $status == Z_OK ; | |
280 | ($Y, $status) = $x->flush() ; | |
281 | ok $status == Z_OK ; | |
282 | $X .= $Y ; | |
283 | $x = 0 ; | |
284 | ||
285 | ok $k = inflateInit(-Dictionary => $dictionary) ; | |
286 | ||
287 | ($Z, $status) = $k->inflate($X); | |
288 | ok $status == Z_STREAM_END ; | |
289 | ok $k->dict_adler() == $dictID; | |
290 | ok $hello eq $Z ; | |
291 | ||
292 | #$Z=''; | |
293 | #while (1) { | |
294 | # ($Z, $status) = $k->inflate($X) ; | |
295 | # last if $status == Z_STREAM_END or $status != Z_OK ; | |
296 | #print "status=[$status] hello=[$hello] Z=[$Z]\n"; | |
297 | #} | |
298 | #ok $status == Z_STREAM_END ; | |
299 | #ok $hello eq $Z | |
300 | # or print "status=[$status] hello=[$hello] Z=[$Z]\n"; | |
301 | ||
302 | ||
303 | ||
304 | ||
305 | ||
306 | ||
307 | title 'inflate - check remaining buffer after Z_STREAM_END'; | |
308 | # =================================================== | |
309 | ||
310 | { | |
311 | ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ; | |
312 | ||
313 | ($X, $status) = $x->deflate($hello) ; | |
314 | ok $status == Z_OK ; | |
315 | ($Y, $status) = $x->flush() ; | |
316 | ok $status == Z_OK ; | |
317 | $X .= $Y ; | |
318 | $x = 0 ; | |
319 | ||
320 | ok $k = inflateInit() ; | |
321 | ||
322 | my $first = substr($X, 0, 2) ; | |
323 | my $last = substr($X, 2) ; | |
324 | ($Z, $status) = $k->inflate($first); | |
325 | ok $status == Z_OK ; | |
326 | ok $first eq "" ; | |
327 | ||
328 | $last .= "appendage" ; | |
329 | my $T; | |
330 | ($T, $status) = $k->inflate($last); | |
331 | ok $status == Z_STREAM_END ; | |
332 | ok $hello eq $Z . $T ; | |
333 | ok $last eq "appendage" ; | |
334 | ||
335 | } | |
336 | ||
337 | title 'memGzip & memGunzip'; | |
338 | { | |
c23ee15d CBW |
339 | my ($name, $name1, $name2, $name3); |
340 | my $lex = new LexFile $name, $name1, $name2, $name3 ; | |
d5e5b609 SH |
341 | my $buffer = <<EOM; |
342 | some sample | |
343 | text | |
344 | ||
345 | EOM | |
346 | ||
347 | my $len = length $buffer ; | |
348 | my ($x, $uncomp) ; | |
349 | ||
350 | ||
351 | # create an in-memory gzip file | |
9b5fd1d4 | 352 | my $dest = memGzip($buffer) ; |
d5e5b609 | 353 | ok length $dest ; |
9b5fd1d4 | 354 | is $gzerrno, 0; |
d5e5b609 SH |
355 | |
356 | # write it to disk | |
357 | ok open(FH, ">$name") ; | |
358 | binmode(FH); | |
359 | print FH $dest ; | |
360 | close FH ; | |
361 | ||
362 | # uncompress with gzopen | |
363 | ok my $fil = gzopen($name, "rb") ; | |
364 | ||
365 | is $fil->gzread($uncomp, 0), 0 ; | |
366 | ok (($x = $fil->gzread($uncomp)) == $len) ; | |
367 | ||
368 | ok ! $fil->gzclose ; | |
369 | ||
370 | ok $uncomp eq $buffer ; | |
371 | ||
c23ee15d | 372 | #1 while unlink $name ; |
d5e5b609 SH |
373 | |
374 | # now check that memGunzip can deal with it. | |
9b5fd1d4 | 375 | my $ungzip = memGunzip($dest) ; |
d5e5b609 SH |
376 | ok defined $ungzip ; |
377 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 378 | is $gzerrno, 0; |
d5e5b609 SH |
379 | |
380 | # now do the same but use a reference | |
381 | ||
9b5fd1d4 | 382 | $dest = memGzip(\$buffer) ; |
d5e5b609 | 383 | ok length $dest ; |
9b5fd1d4 | 384 | is $gzerrno, 0; |
d5e5b609 SH |
385 | |
386 | # write it to disk | |
c23ee15d | 387 | ok open(FH, ">$name1") ; |
d5e5b609 SH |
388 | binmode(FH); |
389 | print FH $dest ; | |
390 | close FH ; | |
391 | ||
392 | # uncompress with gzopen | |
c23ee15d | 393 | ok $fil = gzopen($name1, "rb") ; |
d5e5b609 SH |
394 | |
395 | ok (($x = $fil->gzread($uncomp)) == $len) ; | |
396 | ||
397 | ok ! $fil->gzclose ; | |
398 | ||
399 | ok $uncomp eq $buffer ; | |
400 | ||
401 | # now check that memGunzip can deal with it. | |
402 | my $keep = $dest; | |
9b5fd1d4 PM |
403 | $ungzip = memGunzip(\$dest) ; |
404 | is $gzerrno, 0; | |
d5e5b609 SH |
405 | ok defined $ungzip ; |
406 | ok $buffer eq $ungzip ; | |
407 | ||
408 | # check memGunzip can cope with missing gzip trailer | |
409 | my $minimal = substr($keep, 0, -1) ; | |
9b5fd1d4 | 410 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
411 | ok defined $ungzip ; |
412 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 413 | is $gzerrno, 0; |
d5e5b609 SH |
414 | |
415 | $minimal = substr($keep, 0, -2) ; | |
9b5fd1d4 | 416 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
417 | ok defined $ungzip ; |
418 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 419 | is $gzerrno, 0; |
d5e5b609 SH |
420 | |
421 | $minimal = substr($keep, 0, -3) ; | |
9b5fd1d4 | 422 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
423 | ok defined $ungzip ; |
424 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 425 | is $gzerrno, 0; |
d5e5b609 SH |
426 | |
427 | $minimal = substr($keep, 0, -4) ; | |
9b5fd1d4 | 428 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
429 | ok defined $ungzip ; |
430 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 431 | is $gzerrno, 0; |
d5e5b609 SH |
432 | |
433 | $minimal = substr($keep, 0, -5) ; | |
9b5fd1d4 | 434 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
435 | ok defined $ungzip ; |
436 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 437 | is $gzerrno, 0; |
d5e5b609 SH |
438 | |
439 | $minimal = substr($keep, 0, -6) ; | |
9b5fd1d4 | 440 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
441 | ok defined $ungzip ; |
442 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 443 | is $gzerrno, 0; |
d5e5b609 SH |
444 | |
445 | $minimal = substr($keep, 0, -7) ; | |
9b5fd1d4 | 446 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
447 | ok defined $ungzip ; |
448 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 449 | is $gzerrno, 0; |
d5e5b609 SH |
450 | |
451 | $minimal = substr($keep, 0, -8) ; | |
9b5fd1d4 | 452 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 SH |
453 | ok defined $ungzip ; |
454 | ok $buffer eq $ungzip ; | |
9b5fd1d4 | 455 | is $gzerrno, 0; |
d5e5b609 SH |
456 | |
457 | $minimal = substr($keep, 0, -9) ; | |
9b5fd1d4 | 458 | $ungzip = memGunzip(\$minimal) ; |
d5e5b609 | 459 | ok ! defined $ungzip ; |
9b5fd1d4 | 460 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
461 | |
462 | ||
c23ee15d | 463 | #1 while unlink $name ; |
d5e5b609 SH |
464 | |
465 | # check corrupt header -- too short | |
466 | $dest = "x" ; | |
9b5fd1d4 | 467 | my $result = memGunzip($dest) ; |
d5e5b609 | 468 | ok !defined $result ; |
9b5fd1d4 | 469 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
470 | |
471 | # check corrupt header -- full of junk | |
472 | $dest = "x" x 200 ; | |
9b5fd1d4 | 473 | $result = memGunzip($dest) ; |
d5e5b609 | 474 | ok !defined $result ; |
9b5fd1d4 | 475 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
476 | |
477 | # corrupt header - 1st byte wrong | |
478 | my $bad = $keep ; | |
479 | substr($bad, 0, 1) = "\xFF" ; | |
9b5fd1d4 | 480 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 481 | ok ! defined $ungzip ; |
9b5fd1d4 | 482 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
483 | |
484 | # corrupt header - 2st byte wrong | |
485 | $bad = $keep ; | |
486 | substr($bad, 1, 1) = "\xFF" ; | |
9b5fd1d4 | 487 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 488 | ok ! defined $ungzip ; |
9b5fd1d4 | 489 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
490 | |
491 | # corrupt header - method not deflated | |
492 | $bad = $keep ; | |
493 | substr($bad, 2, 1) = "\xFF" ; | |
9b5fd1d4 | 494 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 495 | ok ! defined $ungzip ; |
9b5fd1d4 | 496 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 | 497 | |
cd0c0e65 | 498 | # corrupt header - reserved bits used |
d5e5b609 SH |
499 | $bad = $keep ; |
500 | substr($bad, 3, 1) = "\xFF" ; | |
9b5fd1d4 | 501 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 502 | ok ! defined $ungzip ; |
9b5fd1d4 | 503 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
504 | |
505 | # corrupt trailer - length wrong | |
506 | $bad = $keep ; | |
507 | substr($bad, -8, 4) = "\xFF" x 4 ; | |
9b5fd1d4 | 508 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 509 | ok ! defined $ungzip ; |
9b5fd1d4 | 510 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
511 | |
512 | # corrupt trailer - CRC wrong | |
513 | $bad = $keep ; | |
514 | substr($bad, -4, 4) = "\xFF" x 4 ; | |
9b5fd1d4 | 515 | $ungzip = memGunzip(\$bad) ; |
d5e5b609 | 516 | ok ! defined $ungzip ; |
9b5fd1d4 | 517 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; |
d5e5b609 SH |
518 | } |
519 | ||
520 | { | |
521 | title "Check all bytes can be handled"; | |
522 | ||
523 | my $lex = new LexFile my $name ; | |
524 | my $data = join '', map { chr } 0x00 .. 0xFF; | |
525 | $data .= "\r\nabd\r\n"; | |
526 | ||
527 | my $fil; | |
528 | ok $fil = gzopen($name, "wb") ; | |
529 | is $fil->gzwrite($data), length $data ; | |
530 | ok ! $fil->gzclose(); | |
531 | ||
532 | my $input; | |
533 | ok $fil = gzopen($name, "rb") ; | |
534 | is $fil->gzread($input), length $data ; | |
535 | ok ! $fil->gzclose(); | |
536 | ok $input eq $data; | |
537 | ||
538 | title "Check all bytes can be handled - transparent mode"; | |
539 | writeFile($name, $data); | |
540 | ok $fil = gzopen($name, "rb") ; | |
541 | is $fil->gzread($input), length $data ; | |
542 | ok ! $fil->gzclose(); | |
543 | ok $input eq $data; | |
544 | ||
545 | } | |
546 | ||
547 | title 'memGunzip with a gzopen created file'; | |
548 | { | |
549 | my $name = "test.gz" ; | |
550 | my $buffer = <<EOM; | |
551 | some sample | |
552 | text | |
553 | ||
554 | EOM | |
555 | ||
556 | ok $fil = gzopen($name, "wb") ; | |
557 | ||
558 | ok $fil->gzwrite($buffer) == length $buffer ; | |
559 | ||
560 | ok ! $fil->gzclose ; | |
561 | ||
562 | my $compr = readFile($name); | |
563 | ok length $compr ; | |
9b5fd1d4 PM |
564 | my $unc = memGunzip($compr) ; |
565 | is $gzerrno, 0; | |
d5e5b609 SH |
566 | ok defined $unc ; |
567 | ok $buffer eq $unc ; | |
568 | 1 while unlink $name ; | |
569 | } | |
570 | ||
571 | { | |
572 | ||
573 | # Check - MAX_WBITS | |
574 | # ================= | |
575 | ||
576 | $hello = "Test test test test test"; | |
577 | @hello = split('', $hello) ; | |
578 | ||
579 | ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ; | |
580 | ok $x ; | |
581 | ok $err == Z_OK ; | |
582 | ||
583 | $Answer = ''; | |
584 | foreach (@hello) | |
585 | { | |
586 | ($X, $status) = $x->deflate($_) ; | |
587 | last unless $status == Z_OK ; | |
588 | ||
589 | $Answer .= $X ; | |
590 | } | |
591 | ||
592 | ok $status == Z_OK ; | |
593 | ||
594 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; | |
595 | $Answer .= $X ; | |
596 | ||
597 | ||
598 | @Answer = split('', $Answer) ; | |
599 | # Undocumented corner -- extra byte needed to get inflate to return | |
600 | # Z_STREAM_END when done. | |
601 | push @Answer, " " ; | |
602 | ||
603 | ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ; | |
604 | ok $k ; | |
605 | ok $err == Z_OK ; | |
606 | ||
607 | $GOT = ''; | |
608 | foreach (@Answer) | |
609 | { | |
610 | ($Z, $status) = $k->inflate($_) ; | |
611 | $GOT .= $Z ; | |
612 | last if $status == Z_STREAM_END or $status != Z_OK ; | |
613 | ||
614 | } | |
615 | ||
616 | ok $status == Z_STREAM_END ; | |
617 | ok $GOT eq $hello ; | |
618 | ||
619 | } | |
620 | ||
621 | { | |
622 | # inflateSync | |
623 | ||
624 | # create a deflate stream with flush points | |
625 | ||
626 | my $hello = "I am a HAL 9000 computer" x 2001 ; | |
627 | my $goodbye = "Will I dream?" x 2010; | |
628 | my ($err, $answer, $X, $status, $Answer); | |
629 | ||
630 | ok (($x, $err) = deflateInit() ) ; | |
631 | ok $x ; | |
632 | ok $err == Z_OK ; | |
633 | ||
634 | ($Answer, $status) = $x->deflate($hello) ; | |
635 | ok $status == Z_OK ; | |
636 | ||
637 | # create a flush point | |
638 | ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ; | |
639 | $Answer .= $X ; | |
640 | ||
641 | ($X, $status) = $x->deflate($goodbye) ; | |
642 | ok $status == Z_OK ; | |
643 | $Answer .= $X ; | |
644 | ||
645 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; | |
646 | $Answer .= $X ; | |
647 | ||
648 | my ($first, @Answer) = split('', $Answer) ; | |
649 | ||
650 | my $k; | |
651 | ok (($k, $err) = inflateInit()) ; | |
652 | ok $k ; | |
653 | ok $err == Z_OK ; | |
654 | ||
655 | ($Z, $status) = $k->inflate($first) ; | |
656 | ok $status == Z_OK ; | |
657 | ||
658 | # skip to the first flush point. | |
659 | while (@Answer) | |
660 | { | |
661 | my $byte = shift @Answer; | |
662 | $status = $k->inflateSync($byte) ; | |
663 | last unless $status == Z_DATA_ERROR; | |
664 | ||
665 | } | |
666 | ||
667 | ok $status == Z_OK; | |
668 | ||
669 | my $GOT = ''; | |
670 | my $Z = ''; | |
671 | foreach (@Answer) | |
672 | { | |
673 | my $Z = ''; | |
674 | ($Z, $status) = $k->inflate($_) ; | |
675 | $GOT .= $Z if defined $Z ; | |
676 | # print "x $status\n"; | |
677 | last if $status == Z_STREAM_END or $status != Z_OK ; | |
678 | ||
679 | } | |
680 | ||
681 | # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR | |
682 | ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ; | |
683 | ok $GOT eq $goodbye ; | |
684 | ||
685 | ||
686 | # Check inflateSync leaves good data in buffer | |
687 | $Answer =~ /^(.)(.*)$/ ; | |
688 | my ($initial, $rest) = ($1, $2); | |
689 | ||
690 | ||
691 | ok (($k, $err) = inflateInit()) ; | |
692 | ok $k ; | |
693 | ok $err == Z_OK ; | |
694 | ||
695 | ($Z, $status) = $k->inflate($initial) ; | |
696 | ok $status == Z_OK ; | |
697 | ||
698 | $status = $k->inflateSync($rest) ; | |
699 | ok $status == Z_OK; | |
700 | ||
701 | ($GOT, $status) = $k->inflate($rest) ; | |
702 | ||
703 | ok $status == Z_DATA_ERROR ; | |
704 | ok $Z . $GOT eq $goodbye ; | |
705 | } | |
706 | ||
707 | { | |
708 | # deflateParams | |
709 | ||
710 | my $hello = "I am a HAL 9000 computer" x 2001 ; | |
711 | my $goodbye = "Will I dream?" x 2010; | |
712 | my ($input, $err, $answer, $X, $status, $Answer); | |
713 | ||
714 | ok (($x, $err) = deflateInit(-Level => Z_BEST_COMPRESSION, | |
715 | -Strategy => Z_DEFAULT_STRATEGY) ) ; | |
716 | ok $x ; | |
717 | ok $err == Z_OK ; | |
718 | ||
719 | ok $x->get_Level() == Z_BEST_COMPRESSION; | |
720 | ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; | |
721 | ||
722 | ($Answer, $status) = $x->deflate($hello) ; | |
723 | ok $status == Z_OK ; | |
724 | $input .= $hello; | |
725 | ||
726 | # error cases | |
727 | eval { $x->deflateParams() }; | |
728 | #like $@, mkErr("^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy"); | |
729 | like $@, "/^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy/"; | |
730 | ||
731 | eval { $x->deflateParams(-Joe => 3) }; | |
732 | like $@, "/^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value/"; | |
733 | #like $@, mkErr("^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value(s) Joe"); | |
734 | #ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/ | |
735 | # or print "# $@\n" ; | |
736 | ||
737 | ok $x->get_Level() == Z_BEST_COMPRESSION; | |
738 | ok $x->get_Strategy() == Z_DEFAULT_STRATEGY; | |
739 | ||
740 | # change both Level & Strategy | |
741 | $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ; | |
742 | ok $status == Z_OK ; | |
743 | ||
744 | ok $x->get_Level() == Z_BEST_SPEED; | |
745 | ok $x->get_Strategy() == Z_HUFFMAN_ONLY; | |
746 | ||
747 | ($X, $status) = $x->deflate($goodbye) ; | |
748 | ok $status == Z_OK ; | |
749 | $Answer .= $X ; | |
750 | $input .= $goodbye; | |
751 | ||
752 | # change only Level | |
753 | $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ; | |
754 | ok $status == Z_OK ; | |
755 | ||
756 | ok $x->get_Level() == Z_NO_COMPRESSION; | |
757 | ok $x->get_Strategy() == Z_HUFFMAN_ONLY; | |
758 | ||
759 | ($X, $status) = $x->deflate($goodbye) ; | |
760 | ok $status == Z_OK ; | |
761 | $Answer .= $X ; | |
762 | $input .= $goodbye; | |
763 | ||
764 | # change only Strategy | |
765 | $status = $x->deflateParams(-Strategy => Z_FILTERED) ; | |
766 | ok $status == Z_OK ; | |
767 | ||
768 | ok $x->get_Level() == Z_NO_COMPRESSION; | |
769 | ok $x->get_Strategy() == Z_FILTERED; | |
770 | ||
771 | ($X, $status) = $x->deflate($goodbye) ; | |
772 | ok $status == Z_OK ; | |
773 | $Answer .= $X ; | |
774 | $input .= $goodbye; | |
775 | ||
776 | ok ((($X, $status) = $x->flush())[1] == Z_OK ) ; | |
777 | $Answer .= $X ; | |
778 | ||
779 | my ($first, @Answer) = split('', $Answer) ; | |
780 | ||
781 | my $k; | |
782 | ok (($k, $err) = inflateInit()) ; | |
783 | ok $k ; | |
784 | ok $err == Z_OK ; | |
785 | ||
786 | ($Z, $status) = $k->inflate($Answer) ; | |
787 | ||
788 | ok $status == Z_STREAM_END | |
789 | or print "# status $status\n"; | |
790 | ok $Z eq $input ; | |
791 | } | |
792 | ||
793 | { | |
794 | # error cases | |
795 | ||
796 | eval { deflateInit(-Level) }; | |
797 | like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/'; | |
798 | ||
799 | eval { inflateInit(-Level) }; | |
800 | like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/'; | |
801 | ||
802 | eval { deflateInit(-Joe => 1) }; | |
803 | ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/; | |
804 | ||
805 | eval { inflateInit(-Joe => 1) }; | |
806 | ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/; | |
807 | ||
808 | eval { deflateInit(-Bufsize => 0) }; | |
809 | ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/; | |
810 | ||
811 | eval { inflateInit(-Bufsize => 0) }; | |
812 | ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/; | |
813 | ||
814 | eval { deflateInit(-Bufsize => -1) }; | |
815 | #ok $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/; | |
816 | ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/; | |
817 | ||
818 | eval { inflateInit(-Bufsize => -1) }; | |
819 | ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/; | |
820 | ||
821 | eval { deflateInit(-Bufsize => "xxx") }; | |
822 | ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/; | |
823 | ||
824 | eval { inflateInit(-Bufsize => "xxx") }; | |
825 | ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/; | |
826 | ||
827 | eval { gzopen([], 0) ; } ; | |
828 | ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/ | |
829 | or print "# $@\n" ; | |
830 | ||
831 | # my $x = Symbol::gensym() ; | |
832 | # eval { gzopen($x, 0) ; } ; | |
833 | # ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/ | |
834 | # or print "# $@\n" ; | |
835 | ||
836 | } | |
837 | ||
838 | if ($] >= 5.005) | |
839 | { | |
840 | # test inflate with a substr | |
841 | ||
842 | ok my $x = deflateInit() ; | |
843 | ||
844 | ok ((my ($X, $status) = $x->deflate($contents))[1] == Z_OK) ; | |
845 | ||
846 | my $Y = $X ; | |
847 | ||
848 | ||
849 | ||
850 | ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ; | |
851 | $Y .= $X ; | |
852 | ||
853 | my $append = "Appended" ; | |
854 | $Y .= $append ; | |
855 | ||
856 | ok $k = inflateInit() ; | |
857 | ||
858 | #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ; | |
859 | ($Z, $status) = $k->inflate(substr($Y, 0)) ; | |
860 | ||
861 | ok $status == Z_STREAM_END ; | |
862 | ok $contents eq $Z ; | |
863 | is $Y, $append; | |
864 | ||
865 | } | |
866 | ||
867 | if ($] >= 5.005) | |
868 | { | |
869 | # deflate/inflate in scalar context | |
870 | ||
871 | ok my $x = deflateInit() ; | |
872 | ||
873 | my $X = $x->deflate($contents); | |
874 | ||
875 | my $Y = $X ; | |
876 | ||
877 | ||
878 | ||
879 | $X = $x->flush(); | |
880 | $Y .= $X ; | |
881 | ||
882 | my $append = "Appended" ; | |
883 | $Y .= $append ; | |
884 | ||
885 | ok $k = inflateInit() ; | |
886 | ||
887 | $Z = $k->inflate(substr($Y, 0, -1)) ; | |
888 | #$Z = $k->inflate(substr($Y, 0)) ; | |
889 | ||
890 | ok $contents eq $Z ; | |
891 | is $Y, $append; | |
892 | ||
893 | } | |
894 | ||
895 | { | |
896 | title 'CRC32' ; | |
897 | ||
898 | # CRC32 of this data should have the high bit set | |
899 | # value in ascii is ZgRNtjgSUW | |
900 | my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; | |
901 | my $expected_crc = 0xCF707A2B ; # 3480255019 | |
902 | ||
903 | my $crc = crc32($data) ; | |
904 | is $crc, $expected_crc; | |
905 | } | |
906 | ||
907 | { | |
908 | title 'Adler32' ; | |
909 | ||
910 | # adler of this data should have the high bit set | |
911 | # value in ascii is lpscOVsAJiUfNComkOfWYBcPhHZ[bT | |
912 | my $data = "\x6c\x70\x73\x63\x4f\x56\x73\x41\x4a\x69\x55\x66" . | |
913 | "\x4e\x43\x6f\x6d\x6b\x4f\x66\x57\x59\x42\x63\x50" . | |
914 | "\x68\x48\x5a\x5b\x62\x54"; | |
915 | my $expected_crc = 0xAAD60AC7 ; # 2866154183 | |
916 | my $crc = adler32($data) ; | |
917 | is $crc, $expected_crc; | |
918 | } | |
919 | ||
920 | { | |
921 | # memGunzip - input > 4K | |
922 | ||
923 | my $contents = '' ; | |
924 | foreach (1 .. 20000) | |
925 | { $contents .= chr int rand 256 } | |
926 | ||
9b5fd1d4 PM |
927 | ok my $compressed = memGzip(\$contents) ; |
928 | is $gzerrno, 0; | |
d5e5b609 SH |
929 | |
930 | ok length $compressed > 4096 ; | |
9b5fd1d4 PM |
931 | ok my $out = memGunzip(\$compressed) ; |
932 | is $gzerrno, 0; | |
d5e5b609 SH |
933 | |
934 | ok $contents eq $out ; | |
935 | is length $out, length $contents ; | |
936 | ||
937 | ||
938 | } | |
939 | ||
940 | ||
941 | { | |
942 | # memGunzip Header Corruption Tests | |
943 | ||
944 | my $string = <<EOM; | |
945 | some text | |
946 | EOM | |
947 | ||
948 | my $good ; | |
949 | ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ; | |
950 | ok $x->write($string) ; | |
951 | ok $x->close ; | |
952 | ||
953 | { | |
954 | title "Header Corruption - Fingerprint wrong 1st byte" ; | |
955 | my $buffer = $good ; | |
956 | substr($buffer, 0, 1) = 'x' ; | |
957 | ||
9b5fd1d4 PM |
958 | ok ! memGunzip(\$buffer) ; |
959 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
960 | } |
961 | ||
962 | { | |
963 | title "Header Corruption - Fingerprint wrong 2nd byte" ; | |
964 | my $buffer = $good ; | |
965 | substr($buffer, 1, 1) = "\xFF" ; | |
966 | ||
9b5fd1d4 PM |
967 | ok ! memGunzip(\$buffer) ; |
968 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
969 | } |
970 | ||
971 | { | |
972 | title "Header Corruption - CM not 8"; | |
973 | my $buffer = $good ; | |
974 | substr($buffer, 2, 1) = 'x' ; | |
975 | ||
9b5fd1d4 PM |
976 | ok ! memGunzip(\$buffer) ; |
977 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
978 | } |
979 | ||
980 | { | |
981 | title "Header Corruption - Use of Reserved Flags"; | |
982 | my $buffer = $good ; | |
983 | substr($buffer, 3, 1) = "\xff"; | |
984 | ||
9b5fd1d4 PM |
985 | ok ! memGunzip(\$buffer) ; |
986 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
987 | } |
988 | ||
989 | } | |
990 | ||
991 | for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1) | |
992 | { | |
993 | title "Header Corruption - Truncated in Extra"; | |
994 | my $string = <<EOM; | |
995 | some text | |
996 | EOM | |
997 | ||
998 | my $truncated ; | |
999 | ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0, | |
1000 | -ExtraField => "hello" x 10 ; | |
1001 | ok $x->write($string) ; | |
1002 | ok $x->close ; | |
1003 | ||
1004 | substr($truncated, $index) = '' ; | |
1005 | ||
9b5fd1d4 PM |
1006 | ok ! memGunzip(\$truncated) ; |
1007 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1008 | |
1009 | ||
1010 | } | |
1011 | ||
1012 | my $Name = "fred" ; | |
1013 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1) | |
1014 | { | |
1015 | title "Header Corruption - Truncated in Name"; | |
1016 | my $string = <<EOM; | |
1017 | some text | |
1018 | EOM | |
1019 | ||
1020 | my $truncated ; | |
1021 | ok my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name; | |
1022 | ok $x->write($string) ; | |
1023 | ok $x->close ; | |
1024 | ||
1025 | substr($truncated, $index) = '' ; | |
1026 | ||
9b5fd1d4 PM |
1027 | ok ! memGunzip(\$truncated) ; |
1028 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1029 | } |
1030 | ||
1031 | my $Comment = "comment" ; | |
1032 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1) | |
1033 | { | |
1034 | title "Header Corruption - Truncated in Comment"; | |
1035 | my $string = <<EOM; | |
1036 | some text | |
1037 | EOM | |
1038 | ||
1039 | my $truncated ; | |
1040 | ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment; | |
1041 | ok $x->write($string) ; | |
1042 | ok $x->close ; | |
1043 | ||
1044 | substr($truncated, $index) = '' ; | |
9b5fd1d4 PM |
1045 | ok ! memGunzip(\$truncated) ; |
1046 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1047 | } |
1048 | ||
1049 | for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1) | |
1050 | { | |
1051 | title "Header Corruption - Truncated in CRC"; | |
1052 | my $string = <<EOM; | |
1053 | some text | |
1054 | EOM | |
1055 | ||
1056 | my $truncated ; | |
1057 | ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1; | |
1058 | ok $x->write($string) ; | |
1059 | ok $x->close ; | |
1060 | ||
1061 | substr($truncated, $index) = '' ; | |
1062 | ||
9b5fd1d4 PM |
1063 | ok ! memGunzip(\$truncated) ; |
1064 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1065 | } |
1066 | ||
1067 | { | |
1068 | title "memGunzip can cope with a gzip header with all possible fields"; | |
1069 | my $string = <<EOM; | |
1070 | some text | |
1071 | EOM | |
1072 | ||
1073 | my $buffer ; | |
1074 | ok my $x = new IO::Compress::Gzip \$buffer, | |
1075 | -Append => 1, | |
1076 | -Strict => 0, | |
1077 | -HeaderCRC => 1, | |
1078 | -Name => "Fred", | |
1079 | -ExtraField => "Extra", | |
1080 | -Comment => 'Comment'; | |
1081 | ok $x->write($string) ; | |
1082 | ok $x->close ; | |
1083 | ||
1084 | ok defined $buffer ; | |
1085 | ||
9b5fd1d4 | 1086 | ok my $got = memGunzip($buffer) |
d5e5b609 SH |
1087 | or diag "gzerrno is $gzerrno" ; |
1088 | is $got, $string ; | |
9b5fd1d4 | 1089 | is $gzerrno, 0; |
d5e5b609 SH |
1090 | } |
1091 | ||
1092 | ||
1093 | { | |
1094 | # Trailer Corruption tests | |
1095 | ||
1096 | my $string = <<EOM; | |
1097 | some text | |
1098 | EOM | |
1099 | ||
1100 | my $good ; | |
1101 | ok my $x = new IO::Compress::Gzip \$good, Append => 1 ; | |
1102 | ok $x->write($string) ; | |
1103 | ok $x->close ; | |
1104 | ||
1105 | foreach my $trim (-8 .. -1) | |
1106 | { | |
1107 | my $got = $trim + 8 ; | |
1108 | title "Trailer Corruption - Trailer truncated to $got bytes" ; | |
1109 | my $buffer = $good ; | |
1110 | ||
1111 | substr($buffer, $trim) = ''; | |
1112 | ||
9b5fd1d4 PM |
1113 | ok my $u = memGunzip(\$buffer) ; |
1114 | is $gzerrno, 0; | |
d5e5b609 SH |
1115 | ok $u eq $string; |
1116 | ||
1117 | } | |
1118 | ||
1119 | { | |
1120 | title "Trailer Corruption - Length Wrong, CRC Correct" ; | |
1121 | my $buffer = $good ; | |
1122 | substr($buffer, -4, 4) = pack('V', 1234); | |
1123 | ||
9b5fd1d4 PM |
1124 | ok ! memGunzip(\$buffer) ; |
1125 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1126 | } |
1127 | ||
1128 | { | |
1129 | title "Trailer Corruption - Length Wrong, CRC Wrong" ; | |
1130 | my $buffer = $good ; | |
1131 | substr($buffer, -4, 4) = pack('V', 1234); | |
1132 | substr($buffer, -8, 4) = pack('V', 1234); | |
1133 | ||
9b5fd1d4 PM |
1134 | ok ! memGunzip(\$buffer) ; |
1135 | cmp_ok $gzerrno, "==", Z_DATA_ERROR ; | |
d5e5b609 SH |
1136 | |
1137 | } | |
1138 | } | |
1139 | ||
1140 | ||
1141 | sub slurp | |
1142 | { | |
1143 | my $name = shift ; | |
1144 | ||
1145 | my $input; | |
1146 | my $fil = gzopen($name, "rb") ; | |
1147 | ok $fil , "opened $name"; | |
1148 | cmp_ok $fil->gzread($input, 50000), ">", 0, "read more than zero bytes"; | |
1149 | ok ! $fil->gzclose(), "closed ok"; | |
1150 | ||
1151 | return $input; | |
1152 | } | |
1153 | ||
1154 | sub trickle | |
1155 | { | |
1156 | my $name = shift ; | |
1157 | ||
1158 | my $got; | |
1159 | my $input; | |
1160 | $fil = gzopen($name, "rb") ; | |
1161 | ok $fil, "opened ok"; | |
1162 | while ($fil->gzread($input, 50000) > 0) | |
1163 | { | |
1164 | $got .= $input; | |
1165 | $input = ''; | |
1166 | } | |
1167 | ok ! $fil->gzclose(), "closed ok"; | |
1168 | ||
1169 | return $got; | |
1170 | ||
1171 | return $input; | |
1172 | } | |
1173 | ||
1174 | { | |
1175 | ||
1176 | title "Append & MultiStream Tests"; | |
1177 | # rt.24041 | |
1178 | ||
1179 | my $lex = new LexFile my $name ; | |
1180 | my $data1 = "the is the first"; | |
1181 | my $data2 = "and this is the second"; | |
1182 | my $trailing = "some trailing data"; | |
1183 | ||
1184 | my $fil; | |
1185 | ||
1186 | title "One file"; | |
1187 | $fil = gzopen($name, "wb") ; | |
1188 | ok $fil, "opened first file"; | |
1189 | is $fil->gzwrite($data1), length $data1, "write data1" ; | |
1190 | ok ! $fil->gzclose(), "Closed"; | |
1191 | ||
1192 | is slurp($name), $data1, "got expected data from slurp"; | |
1193 | is trickle($name), $data1, "got expected data from trickle"; | |
1194 | ||
1195 | title "Two files"; | |
1196 | $fil = gzopen($name, "ab") ; | |
1197 | ok $fil, "opened second file"; | |
1198 | is $fil->gzwrite($data2), length $data2, "write data2" ; | |
1199 | ok ! $fil->gzclose(), "Closed"; | |
1200 | ||
1201 | is slurp($name), $data1 . $data2, "got expected data from slurp"; | |
1202 | is trickle($name), $data1 . $data2, "got expected data from trickle"; | |
1203 | ||
1204 | title "Trailing Data"; | |
1205 | open F, ">>$name"; | |
1206 | print F $trailing; | |
1207 | close F; | |
1208 | ||
1209 | is slurp($name), $data1 . $data2 . $trailing, "got expected data from slurp" ; | |
1210 | is trickle($name), $data1 . $data2 . $trailing, "got expected data from trickle" ; | |
1211 | } | |
1212 | ||
1213 | { | |
1214 | title "gzclose & gzflush return codes"; | |
1215 | # rt.29215 | |
1216 | ||
1217 | my $lex = new LexFile my $name ; | |
1218 | my $data1 = "the is some text"; | |
1219 | my $status; | |
1220 | ||
1221 | $fil = gzopen($name, "wb") ; | |
1222 | ok $fil, "opened first file"; | |
1223 | is $fil->gzwrite($data1), length $data1, "write data1" ; | |
1224 | $status = $fil->gzflush(0xfff); | |
1225 | ok $status, "flush not ok" ; | |
1226 | is $status, Z_STREAM_ERROR; | |
1227 | ok ! $fil->gzflush(), "flush ok" ; | |
1228 | ok ! $fil->gzclose(), "Closed"; | |
1229 | } | |
422d6414 CBW |
1230 | |
1231 | ||
1232 | ||
1233 | { | |
8341ee1e CBW |
1234 | title "repeated calls to flush - no compression"; |
1235 | ||
1236 | my ($err, $x, $X, $status, $data); | |
1237 | ||
1238 | ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); | |
1239 | isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; | |
1240 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; | |
1241 | ||
1242 | ||
1243 | ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; | |
1244 | cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; | |
1245 | ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; | |
1246 | cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; | |
1247 | is $data, "", "no output from second flush"; | |
1248 | } | |
1249 | ||
1250 | { | |
1251 | title "repeated calls to flush - after compression"; | |
422d6414 CBW |
1252 | |
1253 | my $hello = "I am a HAL 9000 computer" ; | |
8341ee1e | 1254 | my ($err, $x, $X, $status, $data); |
422d6414 CBW |
1255 | |
1256 | ok( ($x, $err) = deflateInit ( ), "Create deflate object" ); | |
1257 | isa_ok $x, "Compress::Raw::Zlib::deflateStream" ; | |
1258 | cmp_ok $err, '==', Z_OK, "status is Z_OK" ; | |
1259 | ||
8341ee1e | 1260 | ($data, $status) = $x->deflate($hello) ; |
422d6414 CBW |
1261 | cmp_ok $status, '==', Z_OK, "deflate returned Z_OK" ; |
1262 | ||
8341ee1e CBW |
1263 | ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; |
1264 | cmp_ok $status, '==', Z_OK, "flush returned Z_OK" ; | |
1265 | ($data, $status) = $x->flush(Z_SYNC_FLUSH) ; | |
1266 | cmp_ok $status, '==', Z_OK, "second flush returned Z_OK" ; | |
1267 | is $data, "", "no output from second flush"; | |
422d6414 | 1268 | } |