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 => 208 + $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 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     is $uncomp, $hello, "got expected output" ;
 318 }
 319
 320
 321 {
 322     title "Pass gzopen a filehandle - use open" ;
 323
 324     my $lex = new LexFile my $name ;
 325
 326     my $hello = "hello" ;
 327     my $len = length $hello ;
 328
 329     open F, ">$name" ;
 330
 331     my $fil;
 332     ok $fil = gzopen(*F, "wb") ;
 333
 334     is $fil->gzwrite($hello), $len ;
 335
 336     ok ! $fil->gzclose ;
 337
 338     open F, "<$name" ;
 339     ok $fil = gzopen(*F, "rb") ;
 340
 341     my $uncmomp;
 342     $x = $fil->gzread($uncomp);
 343     is $x, $len ;
 344
 345     ok   $fil->gzeof() ;
 346     ok ! $fil->gzclose ;
 347     ok   $fil->gzeof() ;
 348
 349     is $uncomp, $hello ;
 350
 351
 352 }
 353
 354 foreach my $stdio ( ['-', '-'], [*STDIN, *STDOUT])
 355 {
 356     my $stdin = $stdio->[0];
 357     my $stdout = $stdio->[1];
 358
 359     title "Pass gzopen a filehandle - use $stdin" ;
 360
 361     my $lex = new LexFile my $name ;
 362
 363     my $hello = "hello" ;
 364     my $len = length $hello ;
 365
 366     ok open(SAVEOUT, ">&STDOUT"), "  save STDOUT";
 367     my $dummy = fileno SAVEOUT;
 368     ok open(STDOUT, ">$name"), "  redirect STDOUT" ;
 369
 370     my $status = 0 ;
 371
 372     my $fil = gzopen($stdout, "wb") ;
 373
 374     $status = $fil &&
 375               ($fil->gzwrite($hello) == $len) &&
 376               ($fil->gzclose == 0) ;
 377
 378     open(STDOUT, ">&SAVEOUT");
 379
 380     ok $status, "  wrote to stdout";
 381
 382        open(SAVEIN, "<&STDIN");
 383     ok open(STDIN, "<$name"), "  redirect STDIN";
 384     $dummy = fileno SAVEIN;
 385
 386     ok $fil = gzopen($stdin, "rb") ;
 387
 388     my $uncmomp;
 389     ok (($x = $fil->gzread($uncomp)) == $len)
 390         or print "# length $x, expected $len\n" ;
 391
 392     ok   $fil->gzeof() ;
 393     ok ! $fil->gzclose ;
 394     ok   $fil->gzeof() ;
 395
 396        open(STDIN, "<&SAVEIN");
 397
 398     is $uncomp, $hello ;
 399
 400
 401 }
 402
 403 {
 404     title 'test parameters for gzopen';
 405     my $lex = new LexFile my $name ;
 406
 407     my $fil;
 408
 409     # missing parameters
 410     eval ' $fil = gzopen()  ' ;
 411     like $@, mkEvalErr('Not enough arguments for Compress::Zlib::gzopen'),
 412         '  gzopen with missing mode fails' ;
 413
 414     # unknown parameters
 415     $fil = gzopen($name, "xy") ;
 416     ok ! defined $fil, '  gzopen with unknown mode fails' ;
 417
 418     $fil = gzopen($name, "ab") ;
 419     ok $fil, '  gzopen with mode "ab" is ok' ;
 420
 421     $fil = gzopen($name, "wb6") ;
 422     ok $fil, '  gzopen with mode "wb6" is ok' ;
 423
 424     $fil = gzopen($name, "wbf") ;
 425     ok $fil, '  gzopen with mode "wbf" is ok' ;
 426
 427     $fil = gzopen($name, "wbh") ;
 428     ok $fil, '  gzopen with mode "wbh" is ok' ;
 429 }
 430
 431 {
 432     title 'Read operations when opened for writing';
 433
 434     my $lex = new LexFile my $name ;
 435     my $fil;
 436     ok $fil = gzopen($name, "wb"), '  gzopen for writing' ;
 437     ok !$fil->gzeof(), '    !eof'; ;
 438     is $fil->gzread(), Z_STREAM_ERROR, "    gzread returns Z_STREAM_ERROR" ;
 439     ok ! $fil->gzclose, "  gzclose ok" ;
 440 }
 441
 442 {
 443     title 'write operations when opened for reading';
 444
 445     my $lex = new LexFile my $name ;
 446     my $test = "hello" ;
 447     my $fil;
 448     ok $fil = gzopen($name, "wb"), "  gzopen for writing" ;
 449     is $fil->gzwrite($text), length $text, "    gzwrite ok" ;
 450     ok ! $fil->gzclose, "  gzclose ok" ;
 451
 452     ok $fil = gzopen($name, "rb"), "  gzopen for reading" ;
 453     is $fil->gzwrite(), Z_STREAM_ERROR, "  gzwrite returns Z_STREAM_ERROR" ;
 454 }
 455
 456 {
 457     title 'read/write a non-readable/writable file';
 458
 459     SKIP:
 460     {
 461         my $lex = new LexFile my $name ;
 462         writeFile($name, "abc");
 463         chmod 0444, $name ;
 464
 465         skip "Cannot create non-writable file", 3
 466             if -w $name ;
 467
 468         ok ! -w $name, "  input file not writable";
 469
 470         my $fil = gzopen($name, "wb") ;
 471         ok !$fil, "  gzopen returns undef" ;
 472         ok $gzerrno, "  gzerrno ok" or
 473             diag " gzerrno $gzerrno\n";
 474
 475         chmod 0777, $name ;
 476     }
 477
 478     SKIP:
 479     {
 480         my $lex = new LexFile my $name ;
 481         writeFile($name, "abc");
 482         chmod 0222, $name ;
 483
 484         skip "Cannot create non-readable file", 3
 485             if -r $name ;
 486
 487         ok ! -r $name, "  input file not readable";
 488         $gzerrno = 0;
 489         $fil = gzopen($name, "rb") ;
 490         ok !$fil, "  gzopen returns undef" ;
 491         ok $gzerrno, "  gzerrno ok";
 492         chmod 0777, $name ;
 493     }
 494
 495 }
 496
 497 {
 498     title "gzseek" ;
 499
 500     my $buff ;
 501     my $lex = new LexFile my $name ;
 502
 503     my $first = "beginning" ;
 504     my $last  = "the end" ;
 505     my $iow = gzopen($name, "w");
 506     $iow->gzwrite($first) ;
 507     ok $iow->gzseek(5, SEEK_CUR) ;
 508     is $iow->gztell(), length($first)+5;
 509     ok $iow->gzseek(0, SEEK_CUR) ;
 510     is $iow->gztell(), length($first)+5;
 511     ok $iow->gzseek(length($first)+10, SEEK_SET) ;
 512     is $iow->gztell(), length($first)+10;
 513
 514     $iow->gzwrite($last) ;
 515     $iow->gzclose ;
 516
 517     ok GZreadFile($name) eq $first . "\x00" x 10 . $last ;
 518
 519     my $io = gzopen($name, "r");
 520     ok $io->gzseek(length($first), SEEK_CUR) ;
 521     ok ! $io->gzeof;
 522     is $io->gztell(), length($first);
 523
 524     ok $io->gzread($buff, 5) ;
 525     is $buff, "\x00" x 5 ;
 526     is $io->gztell(), length($first) + 5;
 527
 528     is $io->gzread($buff, 0), 0 ;
 529     #is $buff, "\x00" x 5 ;
 530     is $io->gztell(), length($first) + 5;
 531
 532     ok $io->gzseek(0, SEEK_CUR) ;
 533     my $here = $io->gztell() ;
 534     is $here, length($first)+5;
 535
 536     ok $io->gzseek($here+5, SEEK_SET) ;
 537     is $io->gztell(), $here+5 ;
 538     ok $io->gzread($buff, 100) ;
 539     ok $buff eq $last ;
 540     ok $io->gzeof;
 541 }
 542
 543 {
 544     # seek error cases
 545     my $lex = new LexFile my $name ;
 546
 547     my $a = gzopen($name, "w");
 548
 549     ok ! $a->gzerror()
 550         or print "# gzerrno is $Compress::Zlib::gzerrno \n" ;
 551     eval { $a->gzseek(-1, 10) ; };
 552     like $@, mkErr("gzseek: unknown value, 10, for whence parameter");
 553
 554     eval { $a->gzseek(-1, SEEK_END) ; };
 555     like $@, mkErr("gzseek: cannot seek backwards");
 556
 557     $a->gzwrite("fred");
 558     $a->gzclose ;
 559
 560
 561     my $u = gzopen($name, "r");
 562
 563     eval { $u->gzseek(-1, 10) ; };
 564     like $@, mkErr("gzseek: unknown value, 10, for whence parameter");
 565
 566     eval { $u->gzseek(-1, SEEK_END) ; };
 567     like $@, mkErr("gzseek: SEEK_END not allowed");
 568
 569     eval { $u->gzseek(-1, SEEK_CUR) ; };
 570     like $@, mkErr("gzseek: cannot seek backwards");
 571 }