ext/Compress/Zlib/t/14gzopen.t

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