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

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