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