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

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