4 @INC = ("../lib", "lib/compress");
8 use lib qw(t t/compress);
18 # use Test::NoWarnings, if available
21 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
23 plan tests => 255 + $extra ;
25 use_ok('Compress::Zlib', 2) ;
26 use_ok('IO::Compress::Gzip::Constants') ;
30 # Check zlib_version and ZLIB_VERSION are the same.
31 is Compress::Zlib::zlib_version, ZLIB_VERSION,
32 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
39 #my $name = "test.gz" ;
40 my $lex = new LexFile my $name ;
47 my $len = length $hello ;
51 ok my $fil = gzopen($name, "wb") ;
53 is $gzerrno, 0, 'gzerrno is 0';
54 is $fil->gzerror(), 0, "gzerror() returned 0";
56 is $fil->gztell(), 0, "gztell returned 0";
57 is $gzerrno, 0, 'gzerrno is 0';
59 is $fil->gzwrite($hello), $len ;
60 is $gzerrno, 0, 'gzerrno is 0';
62 is $fil->gztell(), $len, "gztell returned $len";
63 is $gzerrno, 0, 'gzerrno is 0';
67 ok $fil = gzopen($name, "rb") ;
70 is $gzerrno, 0, 'gzerrno is 0';
73 is $fil->gzread($uncomp), $len;
75 is $fil->gztell(), $len;
78 # gzread after eof bahavior
81 is $fil->gzread($xyz), 0, "gzread returns 0 on eof" ;
82 is $xyz, "", "gzread on eof zaps the output buffer [Match 1,x behavior]" ;
87 ok $hello eq $uncomp ;
91 title 'check that a number can be gzipped';
92 my $lex = new LexFile my $name ;
98 ok my $fil = gzopen($name, "wb") ;
102 is $fil->gzwrite($number), $num_len, "gzwrite returned $num_len" ;
103 is $gzerrno, 0, 'gzerrno is 0';
104 ok ! $fil->gzflush(Z_FINISH) ;
106 is $gzerrno, 0, 'gzerrno is 0';
110 cmp_ok $gzerrno, '==', 0;
112 ok $fil = gzopen($name, "rb") ;
115 ok ((my $x = $fil->gzread($uncomp)) == $num_len) ;
117 ok $fil->gzerror() == 0 || $fil->gzerror() == Z_STREAM_END;
118 ok $gzerrno == 0 || $gzerrno == Z_STREAM_END;
125 or print "# gzerrno is $gzerrno\n" ;
127 1 while unlink $name ;
129 ok $number == $uncomp ;
130 ok $number eq $uncomp ;
134 title "now a bigger gzip test";
137 my $lex = new LexFile my $file ;
140 ok my $f = gzopen($file, "wb") ;
142 # generate a long random string
145 { $contents .= chr int rand 256 }
147 my $len = length $contents ;
149 is $f->gzwrite($contents), $len ;
153 ok $f = gzopen($file, "rb") ;
158 is $f->gzread($uncompressed, $len), $len ;
160 is $contents, $uncompressed
162 or print "# Length orig $len" .
163 ", Length uncompressed " . length($uncompressed) . "\n" ;
171 title "gzip - readline tests";
172 # ======================
174 # first create a small gzipped text file
175 my $lex = new LexFile my $name ;
177 my @text = (<<EOM, <<EOM, <<EOM, <<EOM) ;
182 the line after the previous line
187 my $text = join("", @text) ;
189 ok my $fil = gzopen($name, "wb") ;
190 is $fil->gzwrite($text), length($text) ;
193 # now try to read it back in
194 ok $fil = gzopen($name, "rb") ;
197 for my $i (0 .. @text -2)
199 ok $fil->gzreadline($line) > 0;
200 is $line, $text[$i] ;
204 # now read the last line
205 ok $fil->gzreadline($line) > 0;
206 is $line, $text[-1] ;
210 is $fil->gzreadline($line), 0;
218 title "A text file with a very long line (bigger than the internal buffer)";
219 my $lex = new LexFile my $name ;
221 my $line1 = ("abcdefghijklmnopq" x 2000) . "\n" ;
222 my $line2 = "second line\n" ;
223 my $text = $line1 . $line2 ;
224 ok my $fil = gzopen($name, "wb"), " gzopen ok" ;
225 is $fil->gzwrite($text), length $text, " gzwrite ok" ;
226 ok ! $fil->gzclose, " gzclose" ;
228 # now try to read it back in
229 ok $fil = gzopen($name, "rb"), " gzopen" ;
230 ok ! $fil->gzeof(), "! eof" ;
234 while ($fil->gzreadline($line) > 0) {
238 is $i, 2, " looped twice" ;
239 is $got[0], $line1, " got line 1" ;
240 is $got[1], $line2, " hot line 2" ;
242 ok $fil->gzeof(), " gzeof" ;
243 ok ! $fil->gzclose, " gzclose" ;
244 ok $fil->gzeof(), " gzeof" ;
248 title "a text file which is not termined by an EOL";
250 my $lex = new LexFile my $name ;
252 my $line1 = "hello hello, I'm back again\n" ;
253 my $line2 = "there is no end in sight" ;
255 my $text = $line1 . $line2 ;
256 ok my $fil = gzopen($name, "wb"), " gzopen" ;
257 is $fil->gzwrite($text), length $text, " gzwrite" ;
258 ok ! $fil->gzclose, " gzclose" ;
260 # now try to read it back in
261 ok $fil = gzopen($name, "rb"), " gzopen" ;
265 while ($fil->gzreadline($line) > 0) {
269 is $i, 2, " got 2 lines" ;
270 is $got[0], $line1, " line 1 ok" ;
271 is $got[1], $line2, " line 2 ok" ;
273 ok $fil->gzeof(), " gzeof" ;
274 ok ! $fil->gzclose, " gzclose" ;
279 title 'mix gzread and gzreadline';
281 # case 1: read a line, then a block. The block is
282 # smaller than the internal block used by
284 my $lex = new LexFile my $name ;
285 my $line1 = "hello hello, I'm back again\n" ;
286 my $line2 = "abc" x 200 ;
287 my $line3 = "def" x 200 ;
290 my $text = $line1 . $line2 . $line3 ;
292 ok $fil = gzopen($name, "wb"), ' gzopen for write ok' ;
293 is $fil->gzwrite($text), length $text, ' gzwrite ok' ;
294 is $fil->gztell(), length $text, ' gztell ok' ;
295 ok ! $fil->gzclose, ' gzclose ok' ;
297 # now try to read it back in
298 ok $fil = gzopen($name, "rb"), ' gzopen for read ok' ;
299 ok ! $fil->gzeof(), ' !gzeof' ;
300 cmp_ok $fil->gzreadline($line), '>', 0, ' gzreadline' ;
301 is $fil->gztell(), length $line1, ' gztell ok' ;
302 ok ! $fil->gzeof(), ' !gzeof' ;
303 is $line, $line1, ' got expected line' ;
304 cmp_ok $fil->gzread($line, length $line2), '>', 0, ' gzread ok' ;
305 is $fil->gztell(), length($line1)+length($line2), ' gztell ok' ;
306 ok ! $fil->gzeof(), ' !gzeof' ;
307 is $line, $line2, ' read expected block' ;
308 cmp_ok $fil->gzread($line, length $line3), '>', 0, ' gzread ok' ;
309 is $fil->gztell(), length($text), ' gztell ok' ;
310 ok $fil->gzeof(), ' !gzeof' ;
311 is $line, $line3, ' read expected block' ;
312 ok ! $fil->gzclose, ' gzclose' ;
316 title "Pass gzopen a filehandle - use IO::File" ;
318 my $lex = new LexFile my $name ;
320 my $hello = "hello" ;
321 my $len = length $hello ;
323 my $f = new IO::File ">$name" ;
327 ok $fil = gzopen($f, "wb") ;
329 ok $fil->gzwrite($hello) == $len ;
333 $f = new IO::File "<$name" ;
334 ok $fil = gzopen($name, "rb") ;
337 ok (($x = $fil->gzread($uncomp)) == $len)
338 or print "# length $x, expected $len\n" ;
344 is $uncomp, $hello, "got expected output" ;
349 title "Pass gzopen a filehandle - use open" ;
351 my $lex = new LexFile my $name ;
353 my $hello = "hello" ;
354 my $len = length $hello ;
359 ok $fil = gzopen(*F, "wb") ;
361 is $fil->gzwrite($hello), $len ;
366 ok $fil = gzopen(*F, "rb") ;
369 $x = $fil->gzread($uncomp);
381 foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT])
383 my $stdin = $stdio->[0];
384 my $stdout = $stdio->[1];
386 title "Pass gzopen a filehandle - use $stdin" ;
388 my $lex = new LexFile my $name ;
390 my $hello = "hello" ;
391 my $len = length $hello ;
393 ok open(SAVEOUT, ">&STDOUT"), " save STDOUT";
394 my $dummy = fileno SAVEOUT;
395 ok open(STDOUT, ">$name"), " redirect STDOUT" ;
399 my $fil = gzopen($stdout, "wb") ;
402 ($fil->gzwrite($hello) == $len) &&
403 ($fil->gzclose == 0) ;
405 open(STDOUT, ">&SAVEOUT");
407 ok $status, " wrote to stdout";
409 open(SAVEIN, "<&STDIN");
410 ok open(STDIN, "<$name"), " redirect STDIN";
411 $dummy = fileno SAVEIN;
413 ok $fil = gzopen($stdin, "rb") ;
416 ok (($x = $fil->gzread($uncomp)) == $len)
417 or print "# length $x, expected $len\n" ;
423 open(STDIN, "<&SAVEIN");
431 title 'test parameters for gzopen';
432 my $lex = new LexFile my $name ;
437 eval ' $fil = gzopen() ' ;
438 like $@, mkEvalErr('Not enough arguments for Compress::Zlib::gzopen'),
439 ' gzopen with missing mode fails' ;
442 $fil = gzopen($name, "xy") ;
443 ok ! defined $fil, ' gzopen with unknown mode fails' ;
445 $fil = gzopen($name, "ab") ;
446 ok $fil, ' gzopen with mode "ab" is ok' ;
448 $fil = gzopen($name, "wb6") ;
449 ok $fil, ' gzopen with mode "wb6" is ok' ;
451 $fil = gzopen($name, "wbf") ;
452 ok $fil, ' gzopen with mode "wbf" is ok' ;
454 $fil = gzopen($name, "wbh") ;
455 ok $fil, ' gzopen with mode "wbh" is ok' ;
459 title 'Read operations when opened for writing';
461 my $lex = new LexFile my $name ;
463 ok $fil = gzopen($name, "wb"), ' gzopen for writing' ;
464 ok !$fil->gzeof(), ' !eof'; ;
465 is $fil->gzread(), Z_STREAM_ERROR, " gzread returns Z_STREAM_ERROR" ;
466 ok ! $fil->gzclose, " gzclose ok" ;
470 title 'write operations when opened for reading';
472 my $lex = new LexFile my $name ;
475 ok $fil = gzopen($name, "wb"), " gzopen for writing" ;
476 is $fil->gzwrite($text), length $text, " gzwrite ok" ;
477 ok ! $fil->gzclose, " gzclose ok" ;
479 ok $fil = gzopen($name, "rb"), " gzopen for reading" ;
480 is $fil->gzwrite(), Z_STREAM_ERROR, " gzwrite returns Z_STREAM_ERROR" ;
484 title 'read/write a non-readable/writable file';
488 my $lex = new LexFile my $name ;
489 writeFile($name, "abc");
492 skip "Cannot create non-writable file", 3
495 ok ! -w $name, " input file not writable";
497 my $fil = gzopen($name, "wb") ;
498 ok !$fil, " gzopen returns undef" ;
499 ok $gzerrno, " gzerrno ok" or
500 diag " gzerrno $gzerrno\n";
507 my $lex = new LexFile my $name ;
508 skip "Cannot create non-readable file", 3
511 writeFile($name, "abc");
514 skip "Cannot create non-readable file", 3
517 ok ! -r $name, " input file not readable";
519 my $fil = gzopen($name, "rb") ;
520 ok !$fil, " gzopen returns undef" ;
521 ok $gzerrno, " gzerrno ok";
531 my $lex = new LexFile my $name ;
533 my $first = "beginning" ;
534 my $last = "the end" ;
535 my $iow = gzopen($name, "w");
536 $iow->gzwrite($first) ;
537 ok $iow->gzseek(5, SEEK_CUR) ;
538 is $iow->gztell(), length($first)+5;
539 ok $iow->gzseek(0, SEEK_CUR) ;
540 is $iow->gztell(), length($first)+5;
541 ok $iow->gzseek(length($first)+10, SEEK_SET) ;
542 is $iow->gztell(), length($first)+10;
544 $iow->gzwrite($last) ;
547 ok GZreadFile($name) eq $first . "\x00" x 10 . $last ;
549 my $io = gzopen($name, "r");
550 ok $io->gzseek(length($first), SEEK_CUR) ;
552 is $io->gztell(), length($first);
554 ok $io->gzread($buff, 5) ;
555 is $buff, "\x00" x 5 ;
556 is $io->gztell(), length($first) + 5;
558 is $io->gzread($buff, 0), 0 ;
559 #is $buff, "\x00" x 5 ;
560 is $io->gztell(), length($first) + 5;
562 ok $io->gzseek(0, SEEK_CUR) ;
563 my $here = $io->gztell() ;
564 is $here, length($first)+5;
566 ok $io->gzseek($here+5, SEEK_SET) ;
567 is $io->gztell(), $here+5 ;
568 ok $io->gzread($buff, 100) ;
575 my $lex = new LexFile my $name ;
577 my $a = gzopen($name, "w");
580 or print "# gzerrno is $Compress::Zlib::gzerrno \n" ;
581 eval { $a->gzseek(-1, 10) ; };
582 like $@, mkErr("gzseek: unknown value, 10, for whence parameter");
584 eval { $a->gzseek(-1, SEEK_END) ; };
585 like $@, mkErr("gzseek: cannot seek backwards");
591 my $u = gzopen($name, "r");
593 eval { $u->gzseek(-1, 10) ; };
594 like $@, mkErr("gzseek: unknown value, 10, for whence parameter");
596 eval { $u->gzseek(-1, SEEK_END) ; };
597 like $@, mkErr("gzseek: SEEK_END not allowed");
599 eval { $u->gzseek(-1, SEEK_CUR) ; };
600 like $@, mkErr("gzseek: cannot seek backwards");
604 title "gzread ver 1.x compat -- the output buffer is always zapped.";
605 my $lex = new LexFile my $name ;
607 my $a = gzopen($name, "w");
611 my $u = gzopen($name, "r");
614 is $u->gzread($buf1, 0), 0, " gzread returns 0";
615 ok defined $buf1, " output buffer defined";
616 is $buf1, "", " output buffer empty string";
619 is $u->gzread($buf2, 0), 0, " gzread returns 0";
620 ok defined $buf2, " output buffer defined";
621 is $buf2, "", " output buffer empty string";
625 title 'gzreadline does not support $/';
627 my $lex = new LexFile my $name ;
629 my $a = gzopen($name, "w");
631 my $len = length $text;
636 for my $delim ( undef, "", 0, 1, "abc", $text, "\n\n", "\n" )
639 my $u = gzopen($name, "r");
641 is $u->gzreadline($line), length $text, " read $len bytes";
642 is $line, $text, " got expected line";
643 ok ! $u->gzclose, " closed" ;
644 is $/, $delim, ' $/ unchanged by gzreadline';