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