Commit | Line | Data |
642e522c |
1 | |
2 | use lib 't'; |
3 | use strict; |
4 | use warnings; |
5 | use bytes; |
6 | |
7 | use Test::More ; |
8 | use ZlibTestUtils; |
9 | use IO::File ; |
10 | |
11 | BEGIN { |
12 | # use Test::NoWarnings, if available |
13 | my $extra = 0 ; |
14 | $extra = 1 |
15 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
16 | |
17 | plan tests => 208 + $extra ; |
18 | |
19 | use_ok('Compress::Zlib', 2) ; |
20 | use_ok('Compress::Gzip::Constants') ; |
21 | |
22 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
23 | } |
24 | |
25 | |
26 | my $hello = <<EOM ; |
27 | hello world |
28 | this is a test |
29 | EOM |
30 | |
31 | my $len = length $hello ; |
32 | |
33 | # Check zlib_version and ZLIB_VERSION are the same. |
34 | is Compress::Zlib::zlib_version, ZLIB_VERSION, |
35 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; |
36 | |
37 | # gzip tests |
38 | #=========== |
39 | |
40 | my $name = "test.gz" ; |
41 | my ($x, $uncomp) ; |
42 | |
43 | ok my $fil = gzopen($name, "wb") ; |
44 | |
45 | is $gzerrno, 0, 'gzerrno is 0'; |
46 | is $fil->gzerror(), 0, "gzerror() returned 0"; |
47 | |
48 | is $fil->gztell(), 0, "gztell returned 0"; |
49 | is $gzerrno, 0, 'gzerrno is 0'; |
50 | |
51 | is $fil->gzwrite($hello), $len ; |
52 | is $gzerrno, 0, 'gzerrno is 0'; |
53 | |
54 | is $fil->gztell(), $len, "gztell returned $len"; |
55 | is $gzerrno, 0, 'gzerrno is 0'; |
56 | |
57 | ok ! $fil->gzclose ; |
58 | |
59 | ok $fil = gzopen($name, "rb") ; |
60 | |
61 | ok ! $fil->gzeof() ; |
62 | is $gzerrno, 0, 'gzerrno is 0'; |
63 | is $fil->gztell(), 0; |
64 | |
65 | is $fil->gzread($uncomp), $len; |
66 | |
67 | is $fil->gztell(), $len; |
68 | ok $fil->gzeof() ; |
69 | ok ! $fil->gzclose ; |
70 | ok $fil->gzeof() ; |
71 | |
72 | unlink $name ; |
73 | |
74 | ok $hello eq $uncomp ; |
75 | |
76 | # check that a number can be gzipped |
77 | my $number = 7603 ; |
78 | my $num_len = 4 ; |
79 | |
80 | ok $fil = gzopen($name, "wb") ; |
81 | |
82 | is $gzerrno, 0; |
83 | |
84 | is $fil->gzwrite($number), $num_len, "gzwrite returned $num_len" ; |
85 | is $gzerrno, 0, 'gzerrno is 0'; |
86 | ok $fil->gzflush(Z_FINISH) ; |
87 | |
88 | is $gzerrno, 0, 'gzerrno is 0'; |
89 | |
90 | ok ! $fil->gzclose ; |
91 | |
92 | cmp_ok $gzerrno, '==', 0; |
93 | |
94 | ok $fil = gzopen($name, "rb") ; |
95 | |
96 | ok (($x = $fil->gzread($uncomp)) == $num_len) ; |
97 | |
98 | ok $fil->gzerror() == 0 || $fil->gzerror() == Z_STREAM_END; |
99 | ok $gzerrno == 0 || $gzerrno == Z_STREAM_END; |
100 | ok $fil->gzeof() ; |
101 | |
102 | ok ! $fil->gzclose ; |
103 | ok $fil->gzeof() ; |
104 | |
105 | ok $gzerrno == 0 |
106 | or print "# gzerrno is $gzerrno\n" ; |
107 | |
108 | unlink $name ; |
109 | |
110 | ok $number == $uncomp ; |
111 | ok $number eq $uncomp ; |
112 | |
113 | |
114 | # now a bigger gzip test |
115 | |
116 | my $text = 'text' ; |
117 | my $file = "$text.gz" ; |
118 | |
119 | ok my $f = gzopen($file, "wb") ; |
120 | |
121 | # generate a long random string |
122 | my $contents = '' ; |
123 | foreach (1 .. 5000) |
124 | { $contents .= chr int rand 256 } |
125 | |
126 | $len = length $contents ; |
127 | |
128 | ok $f->gzwrite($contents) == $len ; |
129 | |
130 | ok ! $f->gzclose ; |
131 | |
132 | ok $f = gzopen($file, "rb") ; |
133 | |
134 | ok ! $f->gzeof() ; |
135 | |
136 | my $uncompressed ; |
137 | is $f->gzread($uncompressed, $len), $len ; |
138 | |
139 | ok $contents eq $uncompressed |
140 | |
141 | or print "# Length orig $len" . |
142 | ", Length uncompressed " . length($uncompressed) . "\n" ; |
143 | |
144 | ok $f->gzeof() ; |
145 | ok ! $f->gzclose ; |
146 | |
147 | unlink($file) ; |
148 | |
149 | # gzip - readline tests |
150 | # ====================== |
151 | |
152 | # first create a small gzipped text file |
153 | $name = "test.gz" ; |
154 | my @text = (<<EOM, <<EOM, <<EOM, <<EOM) ; |
155 | this is line 1 |
156 | EOM |
157 | the second line |
158 | EOM |
159 | the line after the previous line |
160 | EOM |
161 | the final line |
162 | EOM |
163 | |
164 | $text = join("", @text) ; |
165 | |
166 | ok $fil = gzopen($name, "wb") ; |
167 | ok $fil->gzwrite($text) == length $text ; |
168 | ok ! $fil->gzclose ; |
169 | |
170 | # now try to read it back in |
171 | ok $fil = gzopen($name, "rb") ; |
172 | ok ! $fil->gzeof() ; |
173 | my $line = ''; |
174 | for my $i (0 .. @text -2) |
175 | { |
176 | ok $fil->gzreadline($line) > 0; |
177 | ok $line eq $text[$i] ; |
178 | ok ! $fil->gzeof() ; |
179 | } |
180 | |
181 | # now read the last line |
182 | ok $fil->gzreadline($line) > 0; |
183 | ok $line eq $text[-1] ; |
184 | ok $fil->gzeof() ; |
185 | |
186 | # read past the eof |
187 | is $fil->gzreadline($line), 0; |
188 | |
189 | ok $fil->gzeof() ; |
190 | ok ! $fil->gzclose ; |
191 | ok $fil->gzeof() ; |
192 | unlink($name) ; |
193 | |
194 | # a text file with a very long line (bigger than the internal buffer) |
195 | my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ; |
196 | my $line2 = "second line\n" ; |
197 | $text = $line1 . $line2 ; |
198 | ok $fil = gzopen($name, "wb") ; |
199 | ok $fil->gzwrite($text) == length $text ; |
200 | ok ! $fil->gzclose ; |
201 | |
202 | # now try to read it back in |
203 | ok $fil = gzopen($name, "rb") ; |
204 | ok ! $fil->gzeof() ; |
205 | my $i = 0 ; |
206 | my @got = (); |
207 | while ($fil->gzreadline($line) > 0) { |
208 | $got[$i] = $line ; |
209 | ++ $i ; |
210 | } |
211 | ok $i == 2 ; |
212 | ok $got[0] eq $line1 ; |
213 | ok $got[1] eq $line2 ; |
214 | |
215 | ok $fil->gzeof() ; |
216 | ok ! $fil->gzclose ; |
217 | ok $fil->gzeof() ; |
218 | |
219 | unlink $name ; |
220 | |
221 | # a text file which is not termined by an EOL |
222 | |
223 | $line1 = "hello hello, I'm back again\n" ; |
224 | $line2 = "there is no end in sight" ; |
225 | |
226 | $text = $line1 . $line2 ; |
227 | ok $fil = gzopen($name, "wb") ; |
228 | ok $fil->gzwrite($text) == length $text ; |
229 | ok ! $fil->gzclose ; |
230 | |
231 | # now try to read it back in |
232 | ok $fil = gzopen($name, "rb") ; |
233 | @got = () ; $i = 0 ; |
234 | while ($fil->gzreadline($line) > 0) { |
235 | $got[$i] = $line ; |
236 | ++ $i ; |
237 | } |
238 | ok $i == 2 ; |
239 | ok $got[0] eq $line1 ; |
240 | ok $got[1] eq $line2 ; |
241 | |
242 | ok $fil->gzeof() ; |
243 | ok ! $fil->gzclose ; |
244 | |
245 | unlink $name ; |
246 | |
247 | { |
248 | |
249 | title 'mix gzread and gzreadline'; |
250 | |
251 | # case 1: read a line, then a block. The block is |
252 | # smaller than the internal block used by |
253 | # gzreadline |
254 | my $name = "test.gz" ; |
255 | my $lex = new LexFile $name ; |
256 | $line1 = "hello hello, I'm back again\n" ; |
257 | $line2 = "abc" x 200 ; |
258 | my $line3 = "def" x 200 ; |
259 | |
260 | $text = $line1 . $line2 . $line3 ; |
261 | ok $fil = gzopen($name, "wb"), ' gzopen for write ok' ; |
262 | is $fil->gzwrite($text), length $text, ' gzwrite ok' ; |
263 | is $fil->gztell(), length $text, ' gztell ok' ; |
264 | ok ! $fil->gzclose, ' gzclose ok' ; |
265 | |
266 | # now try to read it back in |
267 | ok $fil = gzopen($name, "rb"), ' gzopen for read ok' ; |
268 | ok ! $fil->gzeof(), ' !gzeof' ; |
269 | cmp_ok $fil->gzreadline($line), '>', 0, ' gzreadline' ; |
270 | is $fil->gztell(), length $line1, ' gztell ok' ; |
271 | ok ! $fil->gzeof(), ' !gzeof' ; |
272 | is $line, $line1, ' got expected line' ; |
273 | cmp_ok $fil->gzread($line, length $line2), '>', 0, ' gzread ok' ; |
274 | is $fil->gztell(), length($line1)+length($line2), ' gztell ok' ; |
275 | ok ! $fil->gzeof(), ' !gzeof' ; |
276 | is $line, $line2, ' read expected block' ; |
277 | cmp_ok $fil->gzread($line, length $line3), '>', 0, ' gzread ok' ; |
278 | is $fil->gztell(), length($text), ' gztell ok' ; |
279 | ok $fil->gzeof(), ' !gzeof' ; |
280 | is $line, $line3, ' read expected block' ; |
281 | ok ! $fil->gzclose, ' gzclose' ; |
282 | } |
283 | |
284 | { |
285 | title "Pass gzopen a filehandle - use IO::File" ; |
286 | |
287 | my $name = "test.gz" ; |
288 | my $lex = new LexFile $name ; |
289 | |
290 | my $hello = "hello" ; |
291 | my $len = length $hello ; |
292 | |
293 | unlink $name ; |
294 | |
295 | my $f = new IO::File ">$name" ; |
296 | ok $f; |
297 | |
298 | ok my $fil = gzopen($f, "wb") ; |
299 | |
300 | ok $fil->gzwrite($hello) == $len ; |
301 | |
302 | ok ! $fil->gzclose ; |
303 | |
304 | $f = new IO::File "<$name" ; |
305 | ok $fil = gzopen($name, "rb") ; |
306 | |
307 | my $uncmomp; |
308 | ok (($x = $fil->gzread($uncomp)) == $len) |
309 | or print "# length $x, expected $len\n" ; |
310 | |
311 | ok $fil->gzeof() ; |
312 | ok ! $fil->gzclose ; |
313 | ok $fil->gzeof() ; |
314 | |
315 | unlink $name ; |
316 | |
317 | ok $hello eq $uncomp ; |
318 | |
319 | |
320 | } |
321 | |
322 | |
323 | { |
324 | title "Pass gzopen a filehandle - use open" ; |
325 | |
326 | my $name = "test.gz" ; |
327 | my $lex = new LexFile $name ; |
328 | |
329 | my $hello = "hello" ; |
330 | my $len = length $hello ; |
331 | |
332 | unlink $name ; |
333 | |
334 | open F, ">$name" ; |
335 | |
336 | ok my $fil = gzopen(*F, "wb") ; |
337 | |
338 | is $fil->gzwrite($hello), $len ; |
339 | |
340 | ok ! $fil->gzclose ; |
341 | |
342 | open F, "<$name" ; |
343 | ok $fil = gzopen(*F, "rb") ; |
344 | |
345 | my $uncmomp; |
346 | $x = $fil->gzread($uncomp); |
347 | is $x, $len ; |
348 | |
349 | ok $fil->gzeof() ; |
350 | ok ! $fil->gzclose ; |
351 | ok $fil->gzeof() ; |
352 | |
353 | unlink $name ; |
354 | |
355 | ok $hello eq $uncomp ; |
356 | |
357 | |
358 | } |
359 | |
360 | foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT]) |
361 | { |
362 | my $stdin = $stdio->[0]; |
363 | my $stdout = $stdio->[1]; |
364 | |
365 | title "Pass gzopen a filehandle - use $stdin" ; |
366 | |
367 | my $name = "test.gz" ; |
368 | my $lex = new LexFile $name ; |
369 | |
370 | my $hello = "hello" ; |
371 | my $len = length $hello ; |
372 | |
373 | unlink $name ; |
374 | |
375 | ok open(SAVEOUT, ">&STDOUT"), " save STDOUT"; |
376 | my $dummy = fileno SAVEOUT; |
377 | ok open(STDOUT, ">$name"), " redirect STDOUT" ; |
378 | |
379 | my $status = 0 ; |
380 | |
381 | my $fil = gzopen($stdout, "wb") ; |
382 | |
383 | $status = $fil && |
384 | ($fil->gzwrite($hello) == $len) && |
385 | ($fil->gzclose == 0) ; |
386 | |
387 | open(STDOUT, ">&SAVEOUT"); |
388 | |
389 | ok $status, " wrote to stdout"; |
390 | |
391 | open(SAVEIN, "<&STDIN"); |
392 | ok open(STDIN, "<$name"), " redirect STDIN"; |
393 | $dummy = fileno SAVEIN; |
394 | |
395 | ok $fil = gzopen($stdin, "rb") ; |
396 | |
397 | my $uncmomp; |
398 | ok (($x = $fil->gzread($uncomp)) == $len) |
399 | or print "# length $x, expected $len\n" ; |
400 | |
401 | ok $fil->gzeof() ; |
402 | ok ! $fil->gzclose ; |
403 | ok $fil->gzeof() ; |
404 | |
405 | open(STDIN, "<&SAVEIN"); |
406 | |
407 | unlink $name ; |
408 | |
409 | ok $hello eq $uncomp ; |
410 | |
411 | |
412 | } |
413 | |
414 | { |
415 | title 'test parameters for gzopen'; |
416 | my $name = "test.gz" ; |
417 | my $lex = new LexFile $name ; |
418 | |
419 | my $fil; |
420 | |
421 | unlink $name ; |
422 | |
423 | # missing parameters |
424 | eval ' $fil = gzopen() ' ; |
425 | like $@, mkEvalErr('Not enough arguments for Compress::Zlib::gzopen'), |
426 | ' gzopen with missing mode fails' ; |
427 | |
428 | # unknown parameters |
429 | $fil = gzopen($name, "xy") ; |
430 | ok ! defined $fil, ' gzopen with unknown mode fails' ; |
431 | |
432 | $fil = gzopen($name, "ab") ; |
433 | ok $fil, ' gzopen with mode "ab" is ok' ; |
434 | |
435 | $fil = gzopen($name, "wb6") ; |
436 | ok $fil, ' gzopen with mode "wb6" is ok' ; |
437 | |
438 | $fil = gzopen($name, "wbf") ; |
439 | ok $fil, ' gzopen with mode "wbf" is ok' ; |
440 | |
441 | $fil = gzopen($name, "wbh") ; |
442 | ok $fil, ' gzopen with mode "wbh" is ok' ; |
443 | } |
444 | |
445 | { |
446 | title 'Read operations when opened for writing'; |
447 | |
448 | my $name = "test.gz" ; |
449 | my $lex = new LexFile $name ; |
450 | ok $fil = gzopen($name, "wb"), ' gzopen for writing' ; |
451 | ok !$fil->gzeof(), ' !eof'; ; |
452 | is $fil->gzread(), Z_STREAM_ERROR, " gzread returns Z_STREAM_ERROR" ; |
453 | } |
454 | |
455 | { |
456 | title 'write operations when opened for reading'; |
457 | |
458 | my $name = "test.gz" ; |
459 | my $lex = new LexFile $name ; |
460 | my $test = "hello" ; |
461 | ok $fil = gzopen($name, "wb"), " gzopen for writing" ; |
462 | is $fil->gzwrite($text), length $text, " gzwrite ok" ; |
463 | ok ! $fil->gzclose, " gzclose ok" ; |
464 | |
465 | ok $fil = gzopen($name, "rb"), " gzopen for reading" ; |
466 | is $fil->gzwrite(), Z_STREAM_ERROR, " gzwrite returns Z_STREAM_ERROR" ; |
467 | } |
468 | |
469 | { |
470 | title 'read/write a non-readable/writable file'; |
471 | |
472 | SKIP: |
473 | { |
474 | my $name ; |
475 | my $lex = new LexFile $name ; |
476 | writeFile($name, "abc"); |
477 | chmod 0444, $name ; |
478 | |
479 | skip "Cannot create non-writable file", 3 |
480 | if -w $name ; |
481 | |
482 | ok ! -w $name, " input file not writable"; |
483 | |
484 | my $fil = gzopen($name, "wb") ; |
485 | ok !$fil, " gzopen returns undef" ; |
486 | ok $gzerrno, " gzerrno ok" or |
487 | diag " gzerrno $gzerrno\n"; |
488 | |
489 | chmod 0777, $name ; |
490 | } |
491 | |
492 | SKIP: |
493 | { |
494 | my $name ; |
495 | my $lex = new LexFile $name ; |
496 | writeFile($name, "abc"); |
497 | chmod 0222, $name ; |
498 | |
499 | skip "Cannot create non-readable file", 3 |
500 | if -r $name ; |
501 | |
502 | ok ! -r $name, " input file not readable"; |
503 | $gzerrno = 0; |
504 | $fil = gzopen($name, "rb") ; |
505 | ok !$fil, " gzopen returns undef" ; |
506 | ok $gzerrno, " gzerrno ok"; |
507 | chmod 0777, $name ; |
508 | } |
509 | |
510 | } |
511 | |
512 | { |
513 | title "gzseek" ; |
514 | |
515 | my $buff ; |
516 | my $name ;#= "test.gz" ; |
517 | my $lex = new LexFile $name ; |
518 | |
519 | my $first = "beginning" ; |
520 | my $last = "the end" ; |
521 | my $iow = gzopen($name, "w"); |
522 | $iow->gzwrite($first) ; |
523 | ok $iow->gzseek(5, SEEK_CUR) ; |
524 | is $iow->gztell(), length($first)+5; |
525 | ok $iow->gzseek(0, SEEK_CUR) ; |
526 | is $iow->gztell(), length($first)+5; |
527 | ok $iow->gzseek(length($first)+10, SEEK_SET) ; |
528 | is $iow->gztell(), length($first)+10; |
529 | |
530 | $iow->gzwrite($last) ; |
531 | $iow->gzclose ; |
532 | |
533 | ok GZreadFile($name) eq $first . "\x00" x 10 . $last ; |
534 | |
535 | my $io = gzopen($name, "r"); |
536 | ok $io->gzseek(length($first), SEEK_CUR) ; |
537 | ok ! $io->gzeof; |
538 | is $io->gztell(), length($first); |
539 | |
540 | ok $io->gzread($buff, 5) ; |
541 | is $buff, "\x00" x 5 ; |
542 | is $io->gztell(), length($first) + 5; |
543 | |
544 | is $io->gzread($buff, 0), 0 ; |
545 | #is $buff, "\x00" x 5 ; |
546 | is $io->gztell(), length($first) + 5; |
547 | |
548 | ok $io->gzseek(0, SEEK_CUR) ; |
549 | my $here = $io->gztell() ; |
550 | is $here, length($first)+5; |
551 | |
552 | ok $io->gzseek($here+5, SEEK_SET) ; |
553 | is $io->gztell(), $here+5 ; |
554 | ok $io->gzread($buff, 100) ; |
555 | ok $buff eq $last ; |
556 | ok $io->gzeof; |
557 | } |
558 | |
559 | { |
560 | # seek error cases |
561 | my $name = "test.gz" ; |
562 | my $lex = new LexFile $name ; |
563 | |
564 | my $a = gzopen($name, "w"); |
565 | |
566 | ok ! $a->gzerror() |
567 | or print "# gzerrno is $Compress::Zlib::gzerrno \n" ; |
568 | eval { $a->gzseek(-1, 10) ; }; |
569 | like $@, mkErr("gzseek: unknown value, 10, for whence parameter"); |
570 | |
571 | eval { $a->gzseek(-1, SEEK_END) ; }; |
572 | like $@, mkErr("gzseek: cannot seek backwards"); |
573 | |
574 | $a->gzwrite("fred"); |
575 | $a->gzclose ; |
576 | |
577 | |
578 | my $u = gzopen($name, "r"); |
579 | |
580 | eval { $u->gzseek(-1, 10) ; }; |
581 | like $@, mkErr("gzseek: unknown value, 10, for whence parameter"); |
582 | |
583 | eval { $u->gzseek(-1, SEEK_END) ; }; |
584 | like $@, mkErr("gzseek: SEEK_END not allowed"); |
585 | |
586 | eval { $u->gzseek(-1, SEEK_CUR) ; }; |
587 | like $@, mkErr("gzseek: cannot seek backwards"); |
588 | } |