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

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