ext/Compress/Zlib/t/04def.t

   1
   2 use lib 't';
   3 use strict;
   4 use warnings;
   5 use bytes;
   6
   7 use Test::More ;
   8 use ZlibTestUtils;
   9
  10 BEGIN
  11 {
  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 => 1775 + $extra ;
  18
  19     use_ok('Compress::Zlib', 2) ;
  20
  21     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  22     use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  23
  24     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  25     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  26
  27     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  28     use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  29
  30 }
  31
  32 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
  33
  34
  35 our ($UncompressClass);
  36
  37
  38 sub myGZreadFile
  39 {
  40     my $filename = shift ;
  41     my $init = shift ;
  42
  43
  44     my $fil = new $UncompressClass $filename,
  45                                     -Strict   => 1,
  46                                     -Append   => 1
  47                                     ;
  48
  49     my $data = '';
  50     $data = $init if defined $init ;
  51     1 while $fil->read($data) > 0;
  52
  53     $fil->close ;
  54     return $data ;
  55 }
  56
  57 # Check zlib_version and ZLIB_VERSION are the same.
  58 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  59     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  60
  61
  62
  63 foreach my $CompressClass ('IO::Compress::Gzip',
  64                            'IO::Compress::Deflate',
  65                            'IO::Compress::RawDeflate')
  66 {
  67
  68     title "Testing $CompressClass";
  69
  70     # Buffer not writable
  71     eval qq[\$a = new $CompressClass(\\1) ;] ;
  72     like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ;
  73
  74     my $out = "" ;
  75     eval qq[\$a = new $CompressClass \$out ;] ;
  76     like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
  77
  78     $out = undef ;
  79     eval qq[\$a = new $CompressClass \$out ;] ;
  80     like $@, mkEvalErr("^$CompressClass: output filename is undef or null string");
  81
  82     my $x ;
  83     my $gz = new $CompressClass(\$x);
  84
  85     foreach my $name (qw(read readline getc))
  86     {
  87         eval " \$gz->$name() " ;
  88         like $@, mkEvalErr("^$name Not Available: File opened only for output");
  89     }
  90
  91     eval ' $gz->write({})' ;
  92     like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference");
  93     #like $@, mkEvalErr("^${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref");
  94
  95     eval ' $gz->syswrite("abc", 1, 5)' ;
  96     like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
  97
  98     eval ' $gz->syswrite("abc", 1, -4)' ;
  99     like $@, mkEvalErr("^${CompressClass}::write: offset outside string");
 100 }
 101
 102
 103 foreach my $CompressClass ('IO::Compress::Gzip',
 104                            'IO::Compress::Deflate',
 105                            'IO::Compress::RawDeflate',
 106                          )
 107 {
 108     $UncompressClass = getInverse($CompressClass);
 109     my $Error = getErrorRef($CompressClass);
 110     my $UnError = getErrorRef($UncompressClass);
 111
 112     title "Testing $UncompressClass";
 113
 114     my $out = "" ;
 115     eval qq[\$a = new $UncompressClass \$out ;] ;
 116     like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
 117
 118     $out = undef ;
 119     eval qq[\$a = new $UncompressClass \$out ;] ;
 120     like $@, mkEvalErr("^$UncompressClass: input filename is undef or null string");
 121
 122     my $lex = new LexFile my $name ;
 123
 124     ok ! -e $name, "  $name does not exist";
 125
 126     eval qq[\$a = new $UncompressClass "$name" ;] ;
 127     is $$UnError, "input file '$name' does not exist";
 128
 129     my $gc ;
 130     my $guz = new $CompressClass(\$gc);
 131     $guz->write("abc") ;
 132     $guz->close();
 133
 134     my $x ;
 135     my $gz = new $UncompressClass(\$gc);
 136
 137     foreach my $name (qw(print printf write))
 138     {
 139         eval " \$gz->$name() " ;
 140         like $@, mkEvalErr("^$name Not Available: File opened only for intput");
 141     }
 142
 143 }
 144
 145 foreach my $CompressClass ('IO::Compress::Gzip',
 146                            'IO::Compress::Deflate',
 147                            'IO::Compress::RawDeflate',
 148                          )
 149 {
 150     $UncompressClass = getInverse($CompressClass);
 151     my $Error = getErrorRef($CompressClass);
 152     my $ErrorUnc = getErrorRef($UncompressClass);
 153
 154
 155     title "Testing $CompressClass and $UncompressClass";
 156
 157     {
 158         my ($a, $x, @x) = ("","","") ;
 159
 160         # Buffer not a scalar reference
 161         eval qq[\$a = new $CompressClass \\\@x ;] ;
 162         like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref");
 163
 164         # Buffer not a scalar reference
 165         eval qq[\$a = new $UncompressClass \\\@x ;] ;
 166         like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref");
 167     }
 168
 169     foreach my $Type ( $CompressClass, $UncompressClass)
 170     {
 171         # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate
 172
 173         my ($a, $x, @x) = ("","","") ;
 174
 175         # Odd number of parameters
 176         eval qq[\$a = new $Type "abc", -Output ] ;
 177         like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1");
 178
 179         # Unknown parameter
 180         eval qq[\$a = new $Type  "anc", -Fred => 123 ;] ;
 181         like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred");
 182
 183         # no in or out param
 184         eval qq[\$a = new $Type ;] ;
 185         like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter");
 186
 187     }
 188
 189
 190     {
 191         # write a very simple compressed file
 192         # and read back
 193         #========================================
 194
 195
 196         my $lex = new LexFile my $name ;
 197
 198         my $hello = <<EOM ;
 199 hello world
 200 this is a test
 201 EOM
 202
 203         {
 204           my $x ;
 205           ok $x = new $CompressClass $name  ;
 206
 207           ok $x->write($hello), "write" ;
 208           ok $x->flush(Z_FINISH), "flush";
 209           ok $x->close, "close" ;
 210         }
 211
 212         {
 213           my $uncomp;
 214           ok my $x = new $UncompressClass $name, -Append => 1  ;
 215
 216           my $len ;
 217           1 while ($len = $x->read($uncomp)) > 0 ;
 218
 219           ok $x->close ;
 220           is $hello, $uncomp ;
 221         }
 222     }
 223
 224     {
 225         # write a very simple compressed file
 226         # and read back
 227         #========================================
 228
 229
 230         my $name = "test.gz" ;
 231         my $lex = new LexFile $name ;
 232
 233         my $hello = <<EOM ;
 234 hello world
 235 this is a test
 236 EOM
 237
 238         {
 239           my $x ;
 240           ok $x = new $CompressClass $name  ;
 241
 242           is $x->write(''), 0, "Write empty string is ok";
 243           is $x->write(undef), 0, "Write undef is ok";
 244           ok $x->write($hello), "Write ok" ;
 245           ok $x->close, "Close ok" ;
 246         }
 247
 248         {
 249           my $uncomp;
 250           my $x = new $UncompressClass $name  ;
 251           ok $x, "creates $UncompressClass $name"  ;
 252
 253           my $data = '';
 254           $data .= $uncomp while $x->read($uncomp) > 0 ;
 255
 256           ok $x->close, "close ok" ;
 257           is $data, $uncomp,"expected output" ;
 258         }
 259     }
 260
 261
 262     {
 263         # write a very simple file with using an IO filehandle
 264         # and read back
 265         #========================================
 266
 267
 268         my $name = "test.gz" ;
 269         my $lex = new LexFile $name ;
 270
 271         my $hello = <<EOM ;
 272 hello world
 273 this is a test
 274 EOM
 275
 276         {
 277           my $fh = new IO::File ">$name" ;
 278           ok $fh, "opened file $name ok";
 279           my $x = new $CompressClass $fh  ;
 280           ok $x, " created $CompressClass $fh"  ;
 281
 282           is $x->fileno(), fileno($fh), "fileno match" ;
 283           is $x->write(''), 0, "Write empty string is ok";
 284           is $x->write(undef), 0, "Write undef is ok";
 285           ok $x->write($hello), "write ok" ;
 286           ok $x->flush(), "flush";
 287           ok $x->close,"close" ;
 288           $fh->close() ;
 289         }
 290
 291         my $uncomp;
 292         {
 293           my $x ;
 294           ok my $fh1 = new IO::File "<$name" ;
 295           ok $x = new $UncompressClass $fh1, -Append => 1  ;
 296           ok $x->fileno() == fileno $fh1 ;
 297
 298           1 while $x->read($uncomp) > 0 ;
 299
 300           ok $x->close ;
 301         }
 302
 303         ok $hello eq $uncomp ;
 304     }
 305
 306     {
 307         # write a very simple file with using a glob filehandle
 308         # and read back
 309         #========================================
 310
 311
 312         my $lex = new LexFile my $name ;
 313
 314         my $hello = <<EOM ;
 315 hello world
 316 this is a test
 317 EOM
 318
 319         {
 320           title "$CompressClass: Input from typeglob filehandle";
 321           ok open FH, ">$name" ;
 322
 323           my $x = new $CompressClass *FH  ;
 324           ok $x, "  create $CompressClass"  ;
 325
 326           is $x->fileno(), fileno(*FH), "  fileno" ;
 327           is $x->write(''), 0, "  Write empty string is ok";
 328           is $x->write(undef), 0, "  Write undef is ok";
 329           ok $x->write($hello), "  Write ok" ;
 330           ok $x->flush(), "  Flush";
 331           ok $x->close, "  Close" ;
 332           close FH;
 333         }
 334
 335         my $uncomp;
 336         {
 337           title "$UncompressClass: Input from typeglob filehandle, append output";
 338           my $x ;
 339           ok open FH, "<$name" ;
 340           ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0  ;
 341           is $x->fileno(), fileno FH, "  fileno ok" ;
 342
 343           1 while $x->read($uncomp) > 0 ;
 344
 345           ok $x->close, "  close" ;
 346         }
 347
 348         is $uncomp, $hello, "  expected output" ;
 349     }
 350
 351     {
 352         my $name = "test.gz" ;
 353         my $lex = new LexFile $name ;
 354
 355         my $hello = <<EOM ;
 356 hello world
 357 this is a test
 358 EOM
 359
 360         {
 361           title "Outout to stdout via '-'" ;
 362
 363           open(SAVEOUT, ">&STDOUT");
 364           my $dummy = fileno SAVEOUT;
 365           open STDOUT, ">$name" ;
 366
 367           my $x = new $CompressClass '-'  ;
 368           $x->write($hello);
 369           $x->close;
 370
 371           open(STDOUT, ">&SAVEOUT");
 372
 373           ok 1, "  wrote to stdout" ;
 374         }
 375
 376         {
 377           title "Input from stdin via filename '-'";
 378
 379           my $x ;
 380           my $uncomp ;
 381           my $stdinFileno = fileno(STDIN);
 382           # open below doesn't return 1 sometines on XP
 383              open(SAVEIN, "<&STDIN");
 384           ok open(STDIN, "<$name"), "  redirect STDIN";
 385           my $dummy = fileno SAVEIN;
 386           $x = new $UncompressClass '-';
 387           ok $x, "  created object" ;
 388           is $x->fileno(), $stdinFileno, "  fileno ok" ;
 389
 390           1 while $x->read($uncomp) > 0 ;
 391
 392           ok $x->close, "  close" ;
 393              open(STDIN, "<&SAVEIN");
 394           is $hello, $uncomp, "  expected output" ;
 395         }
 396     }
 397
 398     {
 399         # write a compressed file to memory
 400         # and read back
 401         #========================================
 402
 403         my $name = "test.gz" ;
 404
 405         my $hello = <<EOM ;
 406 hello world
 407 this is a test
 408 EOM
 409
 410         my $buffer ;
 411         {
 412           my $x ;
 413           ok $x = new $CompressClass(\$buffer) ;
 414
 415           ok ! defined $x->fileno() ;
 416           is $x->write(''), 0, "Write empty string is ok";
 417           is $x->write(undef), 0, "Write undef is ok";
 418           ok $x->write($hello) ;
 419           ok $x->flush();
 420           ok $x->close ;
 421
 422           writeFile($name, $buffer) ;
 423           #is anyUncompress(\$buffer), $hello, "  any ok";
 424         }
 425
 426         my $keep = $buffer ;
 427         my $uncomp;
 428         {
 429           my $x ;
 430           ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
 431
 432           ok ! defined $x->fileno() ;
 433           1 while $x->read($uncomp) > 0  ;
 434
 435           ok $x->close ;
 436         }
 437
 438         is $uncomp, $hello ;
 439         ok $buffer eq $keep ;
 440     }
 441
 442     if ($CompressClass ne 'RawDeflate')
 443     {
 444         # write empty file
 445         #========================================
 446
 447         my $buffer = '';
 448         {
 449           my $x ;
 450           ok $x = new $CompressClass(\$buffer) ;
 451           ok $x->close ;
 452
 453         }
 454
 455         my $keep = $buffer ;
 456         my $uncomp= '';
 457         {
 458           my $x ;
 459           ok $x = new $UncompressClass(\$buffer, Append => 1)  ;
 460
 461           1 while $x->read($uncomp) > 0  ;
 462
 463           ok $x->close ;
 464         }
 465
 466         ok $uncomp eq '' ;
 467         ok $buffer eq $keep ;
 468
 469     }
 470
 471     {
 472         # write a larger file
 473         #========================================
 474
 475
 476         my $lex = new LexFile my $name ;
 477
 478         my $hello = <<EOM ;
 479 hello world
 480 this is a test
 481 EOM
 482
 483         my $input    = '' ;
 484         my $contents = '' ;
 485
 486         {
 487           my $x = new $CompressClass $name  ;
 488           ok $x, "  created $CompressClass object";
 489
 490           ok $x->write($hello), "  write ok" ;
 491           $input .= $hello ;
 492           ok $x->write("another line"), "  write ok" ;
 493           $input .= "another line" ;
 494           # all characters
 495           foreach (0 .. 255)
 496             { $contents .= chr int $_ }
 497           # generate a long random string
 498           foreach (1 .. 5000)
 499             { $contents .= chr int rand 256 }
 500
 501           ok $x->write($contents), "  write ok" ;
 502           $input .= $contents ;
 503           ok $x->close, "  close ok" ;
 504         }
 505
 506         ok myGZreadFile($name) eq $input ;
 507         my $x =  readFile($name) ;
 508         #print "length " . length($x) . " \n";
 509     }
 510
 511     {
 512         # embed a compressed file in another file
 513         #================================
 514
 515
 516         my $name = "test.gz" ;
 517         my $lex = new LexFile $name ;
 518
 519         my $hello = <<EOM ;
 520 hello world
 521 this is a test
 522 EOM
 523
 524         my $header = "header info\n" ;
 525         my $trailer = "trailer data\n" ;
 526
 527         {
 528           my $fh ;
 529           ok $fh = new IO::File ">$name" ;
 530           print $fh $header ;
 531           my $x ;
 532           ok $x = new $CompressClass $fh,
 533                                      -AutoClose => 0   ;
 534
 535           ok $x->binmode();
 536           ok $x->write($hello) ;
 537           ok $x->close ;
 538           print $fh $trailer ;
 539           $fh->close() ;
 540         }
 541
 542         my ($fil, $uncomp) ;
 543         my $fh1 ;
 544         ok $fh1 = new IO::File "<$name" ;
 545         # skip leading junk
 546         my $line = <$fh1> ;
 547         ok $line eq $header ;
 548
 549         ok my $x = new $UncompressClass $fh1  ;
 550         ok $x->binmode();
 551         my $got = $x->read($uncomp);
 552
 553         ok $uncomp eq $hello ;
 554         my $rest ;
 555         read($fh1, $rest, 5000);
 556         is ${ $x->trailingData() } . $rest, $trailer ;
 557         #print ${ $x->trailingData() } . $rest ;
 558
 559     }
 560
 561     {
 562         # Write
 563         # these tests come almost 100% from IO::String
 564
 565         my $name = "test.gz" ;
 566         my $lex = new LexFile $name ;
 567
 568         my $io = $CompressClass->new($name);
 569
 570         is $io->tell(), 0, " tell returns 0"; ;
 571
 572         my $heisan = "Heisan\n";
 573         $io->print($heisan) ;
 574
 575         ok ! $io->eof(), "  ! eof";
 576
 577         is $io->tell(), length($heisan), "  tell is " . length($heisan) ;
 578
 579         $io->print("a", "b", "c");
 580
 581         {
 582             local($\) = "\n";
 583             $io->print("d", "e");
 584             local($,) = ",";
 585             $io->print("f", "g", "h");
 586         }
 587
 588         {
 589             local($\) ;
 590             $io->print("D", "E");
 591             local($,) = ".";
 592             $io->print("F", "G", "H");
 593         }
 594
 595         my $foo = "1234567890";
 596
 597         is $io->syswrite($foo, length($foo)), length($foo), "  syswrite ok" ;
 598         if ( $[ < 5.6 )
 599           { is $io->syswrite($foo, length $foo), length $foo, "  syswrite ok" }
 600         else
 601           { is $io->syswrite($foo), length $foo, "  syswrite ok" }
 602         is $io->syswrite($foo, length($foo)), length $foo, "  syswrite ok";
 603         is $io->write($foo, length($foo), 5), 5,   " write 5";
 604         is $io->write("xxx\n", 100, -1), 1, "  write 1";
 605
 606         for (1..3) {
 607             $io->printf("i(%d)", $_);
 608             $io->printf("[%d]\n", $_);
 609         }
 610         $io->print("\n");
 611
 612         $io->close ;
 613
 614         ok $io->eof(), "  eof";
 615
 616         is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" .
 617                                 ("1234567890" x 3) . "67890\n" .
 618                                     "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
 619
 620
 621     }
 622
 623     {
 624         # Read
 625         my $str = <<EOT;
 626 This is an example
 627 of a paragraph
 628
 629
 630 and a single line.
 631
 632 EOT
 633
 634         my $name = "test.gz" ;
 635         my $lex = new LexFile $name ;
 636
 637         my %opts = () ;
 638         %opts = (CRC32 => 1, Adler32 => 1)
 639             if $CompressClass ne "IO::Compress::Gzip";
 640         my $iow = new $CompressClass $name, %opts;
 641         $iow->print($str) ;
 642         $iow->close ;
 643
 644         my @tmp;
 645         my $buf;
 646         {
 647             my $io = new $UncompressClass $name ;
 648
 649             ok ! $io->eof;
 650             is $io->tell(), 0 ;
 651             #my @lines = <$io>;
 652             my @lines = $io->getlines();
 653             is @lines, 6
 654                 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
 655             is $lines[1], "of a paragraph\n" ;
 656             is join('', @lines), $str ;
 657             is $., 6;
 658             is $io->tell(), length($str) ;
 659
 660             ok $io->eof;
 661
 662             ok ! ( defined($io->getline)  ||
 663                       (@tmp = $io->getlines) ||
 664                       defined($io->getline)         ||
 665                       defined($io->getc)     ||
 666                       $io->read($buf, 100)   != 0) ;
 667         }
 668
 669
 670         {
 671             local $/;  # slurp mode
 672             my $io = $UncompressClass->new($name);
 673             ok ! $io->eof;
 674             my @lines = $io->getlines;
 675             ok $io->eof;
 676             ok @lines == 1 && $lines[0] eq $str;
 677
 678             $io = $UncompressClass->new($name);
 679             ok ! $io->eof;
 680             my $line = $io->getline();
 681             ok $line eq $str;
 682             ok $io->eof;
 683         }
 684
 685         {
 686             local $/ = "";  # paragraph mode
 687             my $io = $UncompressClass->new($name);
 688             ok ! $io->eof;
 689             my @lines = $io->getlines();
 690             ok $io->eof;
 691             ok @lines == 2
 692                 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
 693             ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
 694                 or print "# $lines[0]\n";
 695             ok $lines[1] eq "and a single line.\n\n";
 696         }
 697
 698         {
 699             local $/ = "is";
 700             my $io = $UncompressClass->new($name);
 701             my @lines = ();
 702             my $no = 0;
 703             my $err = 0;
 704             ok ! $io->eof;
 705             while (my $a = $io->getline()) {
 706                 push(@lines, $a);
 707                 $err++ if $. != ++$no;
 708             }
 709
 710             ok $err == 0 ;
 711             ok $io->eof;
 712
 713             ok @lines == 3
 714                 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
 715             ok join("-", @lines) eq
 716                              "This- is- an example\n" .
 717                             "of a paragraph\n\n\n" .
 718                             "and a single line.\n\n";
 719         }
 720
 721
 722         # Test read
 723
 724         {
 725             my $io = $UncompressClass->new($name);
 726
 727
 728             eval { $io->read(1) } ;
 729             like $@, mkErr("buffer parameter is read-only");
 730
 731             is $io->read($buf, 0), 0, "Requested 0 bytes" ;
 732
 733             ok $io->read($buf, 3) == 3 ;
 734             ok $buf eq "Thi";
 735
 736             ok $io->sysread($buf, 3, 2) == 3 ;
 737             ok $buf eq "Ths i"
 738                 or print "# [$buf]\n" ;;
 739             ok ! $io->eof;
 740
 741     #        $io->seek(-4, 2);
 742     #
 743     #        ok ! $io->eof;
 744     #
 745     #        ok read($io, $buf, 20) == 4 ;
 746     #        ok $buf eq "e.\n\n";
 747     #
 748     #        ok read($io, $buf, 20) == 0 ;
 749     #        ok $buf eq "";
 750     #
 751     #        ok ! $io->eof;
 752         }
 753
 754     }
 755
 756     {
 757         # Read from non-compressed file
 758
 759         my $str = <<EOT;
 760 This is an example
 761 of a paragraph
 762
 763
 764 and a single line.
 765
 766 EOT
 767
 768         my $name = "test.gz" ;
 769         my $lex = new LexFile $name ;
 770
 771         writeFile($name, $str);
 772         my @tmp;
 773         my $buf;
 774         {
 775             my $io = new $UncompressClass $name, -Transparent => 1 ;
 776
 777             ok defined $io;
 778             ok ! $io->eof;
 779             ok $io->tell() == 0 ;
 780             my @lines = $io->getlines();
 781             ok @lines == 6;
 782             ok $lines[1] eq "of a paragraph\n" ;
 783             ok join('', @lines) eq $str ;
 784             ok $. == 6;
 785             ok $io->tell() == length($str) ;
 786
 787             ok $io->eof;
 788
 789             ok ! ( defined($io->getline)  ||
 790                       (@tmp = $io->getlines) ||
 791                       defined($io->getline)         ||
 792                       defined($io->getc)     ||
 793                       $io->read($buf, 100)   != 0) ;
 794         }
 795
 796
 797         {
 798             local $/;  # slurp mode
 799             my $io = $UncompressClass->new($name);
 800             ok ! $io->eof;
 801             my @lines = $io->getlines;
 802             ok $io->eof;
 803             ok @lines == 1 && $lines[0] eq $str;
 804
 805             $io = $UncompressClass->new($name);
 806             ok ! $io->eof;
 807             my $line = $io->getline;
 808             ok $line eq $str;
 809             ok $io->eof;
 810         }
 811
 812         {
 813             local $/ = "";  # paragraph mode
 814             my $io = $UncompressClass->new($name);
 815             ok ! $io->eof;
 816             my @lines = $io->getlines;
 817             ok $io->eof;
 818             ok @lines == 2
 819                 or print "# exected 2 lines, got " . scalar(@lines) . "\n";
 820             ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
 821                 or print "# [$lines[0]]\n" ;
 822             ok $lines[1] eq "and a single line.\n\n";
 823         }
 824
 825         {
 826             local $/ = "is";
 827             my $io = $UncompressClass->new($name);
 828             my @lines = ();
 829             my $no = 0;
 830             my $err = 0;
 831             ok ! $io->eof;
 832             while (my $a = $io->getline) {
 833                 push(@lines, $a);
 834                 $err++ if $. != ++$no;
 835             }
 836
 837             ok $err == 0 ;
 838             ok $io->eof;
 839
 840             ok @lines == 3 ;
 841             ok join("-", @lines) eq
 842                              "This- is- an example\n" .
 843                             "of a paragraph\n\n\n" .
 844                             "and a single line.\n\n";
 845         }
 846
 847
 848         # Test read
 849
 850         {
 851             my $io = $UncompressClass->new($name);
 852
 853             ok $io->read($buf, 3) == 3 ;
 854             ok $buf eq "Thi";
 855
 856             ok $io->sysread($buf, 3, 2) == 3 ;
 857             ok $buf eq "Ths i";
 858             ok ! $io->eof;
 859
 860     #        $io->seek(-4, 2);
 861     #
 862     #        ok ! $io->eof;
 863     #
 864     #        ok read($io, $buf, 20) == 4 ;
 865     #        ok $buf eq "e.\n\n";
 866     #
 867     #        ok read($io, $buf, 20) == 0 ;
 868     #        ok $buf eq "";
 869     #
 870     #        ok ! $io->eof;
 871         }
 872
 873
 874     }
 875
 876     {
 877         # Vary the length parameter in a read
 878
 879         my $str = <<EOT;
 880 x
 881 x
 882 This is an example
 883 of a paragraph
 884
 885
 886 and a single line.
 887
 888 EOT
 889         $str = $str x 100 ;
 890
 891
 892         foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
 893         {
 894             foreach my $trans (0, 1)
 895             {
 896                 foreach my $append (0, 1)
 897                 {
 898                     title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
 899
 900                     my $name = "testz.gz" ;
 901                     my $lex = new LexFile $name ;
 902
 903                     if ($trans) {
 904                         writeFile($name, $str) ;
 905                     }
 906                     else {
 907                         my $iow = new $CompressClass $name;
 908                         $iow->print($str) ;
 909                         $iow->close ;
 910                     }
 911
 912
 913                     my $io = $UncompressClass->new($name,
 914                                                    -Append => $append,
 915                                                    -Transparent  => $trans);
 916
 917                     my $buf;
 918
 919                     is $io->tell(), 0;
 920
 921                     if ($append) {
 922                         1 while $io->read($buf, $bufsize) > 0;
 923                     }
 924                     else {
 925                         my $tmp ;
 926                         $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
 927                     }
 928                     is length $buf, length $str;
 929                     ok $buf eq $str ;
 930                     ok ! $io->error() ;
 931                     ok $io->eof;
 932                 }
 933             }
 934         }
 935     }
 936
 937     foreach my $file (0, 1)
 938     {
 939         foreach my $trans (0, 1)
 940         {
 941             title "seek tests - file $file trans $trans" ;
 942
 943             my $buffer ;
 944             my $buff ;
 945             my $name = "test.gz" ;
 946             my $lex = new LexFile $name ;
 947
 948             my $first = "beginning" ;
 949             my $last  = "the end" ;
 950
 951             if ($trans)
 952             {
 953                 $buffer = $first . "\x00" x 10 . $last;
 954                 writeFile($name, $buffer);
 955             }
 956             else
 957             {
 958                 my $output ;
 959                 if ($file)
 960                 {
 961                     $output = $name ;
 962                 }
 963                 else
 964                 {
 965                     $output = \$buffer;
 966                 }
 967
 968                 my $iow = new $CompressClass $output ;
 969                 $iow->print($first) ;
 970                 ok $iow->seek(5, SEEK_CUR) ;
 971                 ok $iow->tell() == length($first)+5;
 972                 ok $iow->seek(0, SEEK_CUR) ;
 973                 ok $iow->tell() == length($first)+5;
 974                 ok $iow->seek(length($first)+10, SEEK_SET) ;
 975                 ok $iow->tell() == length($first)+10;
 976
 977                 $iow->print($last) ;
 978                 $iow->close ;
 979             }
 980
 981             my $input ;
 982             if ($file)
 983             {
 984                 $input = $name ;
 985             }
 986             else
 987             {
 988                 $input = \$buffer ;
 989             }
 990
 991             ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ;
 992
 993             my $io = $UncompressClass->new($input, Strict => 1);
 994             ok $io->seek(length($first), SEEK_CUR) ;
 995             ok ! $io->eof;
 996             is $io->tell(), length($first);
 997
 998             ok $io->read($buff, 5) ;
 999             is $buff, "\x00" x 5 ;
1000             is $io->tell(), length($first) + 5;
1001
1002             ok $io->seek(0, SEEK_CUR) ;
1003             my $here = $io->tell() ;
1004             is $here, length($first)+5;
1005
1006             ok $io->seek($here+5, SEEK_SET) ;
1007             is $io->tell(), $here+5 ;
1008             ok $io->read($buff, 100) ;
1009             ok $buff eq $last ;
1010             ok $io->eof;
1011         }
1012     }
1013
1014     {
1015         title "seek error cases" ;
1016
1017         my $b ;
1018         my $a = new $CompressClass(\$b)  ;
1019
1020         ok ! $a->error() ;
1021         eval { $a->seek(-1, 10) ; };
1022         like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter");
1023
1024         eval { $a->seek(-1, SEEK_END) ; };
1025         like $@, mkErr("^${CompressClass}::seek: cannot seek backwards");
1026
1027         $a->write("fred");
1028         $a->close ;
1029
1030
1031         my $u = new $UncompressClass(\$b)  ;
1032
1033         eval { $u->seek(-1, 10) ; };
1034         like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter");
1035
1036         eval { $u->seek(-1, SEEK_END) ; };
1037         like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed");
1038
1039         eval { $u->seek(-1, SEEK_CUR) ; };
1040         like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards");
1041     }
1042
1043     foreach my $fb (qw(filename buffer filehandle))
1044     {
1045         foreach my $append (0, 1)
1046         {
1047             {
1048                 title "$CompressClass -- Append $append, Output to $fb" ;
1049
1050                 my $name = "test.gz" ;
1051                 my $lex = new LexFile $name ;
1052
1053                 my $already = 'already';
1054                 my $buffer = $already;
1055                 my $output;
1056
1057                 if ($fb eq 'buffer')
1058                   { $output = \$buffer }
1059                 elsif ($fb eq 'filename')
1060                 {
1061                     $output = $name ;
1062                     writeFile($name, $buffer);
1063                 }
1064                 elsif ($fb eq 'filehandle')
1065                 {
1066                     $output = new IO::File ">$name" ;
1067                     print $output $buffer;
1068                 }
1069
1070                 my $a = new $CompressClass($output, Append => $append)  ;
1071                 ok $a, "  Created $CompressClass";
1072                 my $string = "appended";
1073                 $a->write($string);
1074                 $a->close ;
1075
1076                 my $data ;
1077                 if ($fb eq 'buffer')
1078                 {
1079                     $data = $buffer;
1080                 }
1081                 else
1082                 {
1083                     $output->close
1084                         if $fb eq 'filehandle';
1085                     $data = readFile($name);
1086                 }
1087
1088                 if ($append || $fb eq 'filehandle')
1089                 {
1090                     is substr($data, 0, length($already)), $already, "  got prefix";
1091                     substr($data, 0, length($already)) = '';
1092                 }
1093
1094
1095                 my $uncomp;
1096                 my $x = new $UncompressClass(\$data, Append => 1)  ;
1097                 ok $x, "  created $UncompressClass";
1098
1099                 my $len ;
1100                 1 while ($len = $x->read($uncomp)) > 0 ;
1101
1102                 $x->close ;
1103                 is $uncomp, $string, '  Got uncompressed data' ;
1104
1105             }
1106         }
1107     }
1108
1109     foreach my $type (qw(buffer filename filehandle))
1110     {
1111         title "$UncompressClass -- InputLength, read from $type";
1112
1113         my $compressed ;
1114         my $string = "some data";
1115         my $c = new $CompressClass(\$compressed);
1116         $c->write($string);
1117         $c->close();
1118
1119         my $appended = "append";
1120         my $comp_len = length $compressed;
1121         $compressed .= $appended;
1122
1123         my $name = "test.gz" ;
1124         my $lex = new LexFile $name ;
1125         my $input ;
1126         writeFile ($name, $compressed);
1127
1128         if ($type eq 'buffer')
1129         {
1130             $input = \$compressed;
1131         }
1132         if ($type eq 'filename')
1133         {
1134             $input = $name;
1135         }
1136         elsif ($type eq 'filehandle')
1137         {
1138             my $fh = new IO::File "<$name" ;
1139             ok $fh, "opened file $name ok";
1140             $input = $fh ;
1141         }
1142
1143         my $x = new $UncompressClass($input, InputLength => $comp_len)  ;
1144         ok $x, "  created $UncompressClass";
1145
1146         my $len ;
1147         my $output;
1148         $len = $x->read($output, 100);
1149         is $len, length($string);
1150         is $output, $string;
1151
1152         if ($type eq 'filehandle')
1153         {
1154             my $rest ;
1155             $input->read($rest, 1000);
1156             is $rest, $appended;
1157         }
1158
1159
1160     }
1161
1162     foreach my $append (0, 1)
1163     {
1164         title "$UncompressClass -- Append $append" ;
1165
1166         my $name = "test.gz" ;
1167         my $lex = new LexFile $name ;
1168
1169         my $string = "appended";
1170         my $compressed ;
1171         my $c = new $CompressClass(\$compressed);
1172         $c->write($string);
1173         $c->close();
1174
1175         my $x = new $UncompressClass(\$compressed, Append => $append)  ;
1176         ok $x, "  created $UncompressClass";
1177
1178         my $already = 'already';
1179         my $output = $already;
1180
1181         my $len ;
1182         $len = $x->read($output, 100);
1183         is $len, length($string);
1184
1185         $x->close ;
1186
1187         if ($append)
1188         {
1189             is substr($output, 0, length($already)), $already, "  got prefix";
1190             substr($output, 0, length($already)) = '';
1191         }
1192         is $output, $string, '  Got uncompressed data' ;
1193     }
1194
1195
1196     foreach my $file (0, 1)
1197     {
1198         foreach my $trans (0, 1)
1199         {
1200             title "ungetc, File $file, Transparent $trans" ;
1201
1202             my $name = "test.gz" ;
1203             my $lex = new LexFile $name ;
1204
1205             my $string = 'abcdeABCDE';
1206             my $b ;
1207             if ($trans)
1208             {
1209                 $b = $string ;
1210             }
1211             else
1212             {
1213                 my $a = new $CompressClass(\$b)  ;
1214                 $a->write($string);
1215                 $a->close ;
1216             }
1217
1218             my $from ;
1219             if ($file)
1220             {
1221                 writeFile($name, $b);
1222                 $from = $name ;
1223             }
1224             else
1225             {
1226                 $from = \$b ;
1227             }
1228
1229             my $u = $UncompressClass->new($from, Transparent => 1)  ;
1230             my $first;
1231             my $buff ;
1232
1233             # do an ungetc before reading
1234             $u->ungetc("X");
1235             $first = $u->getc();
1236             is $first, 'X';
1237
1238             $first = $u->getc();
1239             is $first, substr($string, 0,1);
1240             $u->ungetc($first);
1241             $first = $u->getc();
1242             is $first, substr($string, 0,1);
1243             $u->ungetc($first);
1244
1245             is $u->read($buff, 5), 5 ;
1246             is $buff, substr($string, 0, 5);
1247
1248             $u->ungetc($buff) ;
1249             is $u->read($buff, length($string)), length($string) ;
1250             is $buff, $string;
1251
1252             ok $u->eof() ;
1253
1254             my $extra = 'extra';
1255             $u->ungetc($extra);
1256             ok ! $u->eof();
1257             is $u->read($buff), length($extra) ;
1258             is $buff, $extra;
1259
1260             ok $u->eof() ;
1261
1262             $u->close();
1263
1264         }
1265     }
1266
1267     {
1268         title "inflateSync on plain file";
1269
1270         my $hello = "I am a HAL 9000 computer" x 2001 ;
1271
1272         my ($k, $err) = new $UncompressClass(\$hello, Transparent => 1);
1273         ok $k ;
1274         cmp_ok $err, '==', Z_OK ;
1275
1276         # Skip to the flush point -- no-op for plain file
1277         my $status = $k->inflateSync();
1278         is $status, 1
1279             or diag $k->error() ;
1280
1281         my $rest;
1282         is $k->read($rest, length($hello)), length($hello)
1283             or diag $k->error() ;
1284         ok $rest eq $hello ;
1285
1286         ok $k->close();
1287     }
1288
1289     {
1290         title "inflateSync for real";
1291
1292         # create a deflate stream with flush points
1293
1294         my $hello = "I am a HAL 9000 computer" x 2001 ;
1295         my $goodbye = "Will I dream?" x 2010;
1296         my ($x, $err, $answer, $X, $Z, $status);
1297         my $Answer ;
1298
1299         ok ($x = new $CompressClass(\$Answer));
1300         ok $x ;
1301
1302         is $x->write($hello), length($hello);
1303
1304         # create a flush point
1305         ok $x->flush(Z_FULL_FLUSH) ;
1306
1307         is $x->write($goodbye), length($goodbye);
1308
1309         ok $x->close() ;
1310
1311         my $k;
1312         ($k, $err) = new $UncompressClass(\$Answer, BlockSize => 1);
1313         ok $k ;
1314         cmp_ok $err, '==', Z_OK ;
1315
1316         my $initial;
1317         is $k->read($initial, 1), 1 ;
1318         is $initial, substr($hello, 0, 1);
1319
1320         # Skip to the flush point
1321         $status = $k->inflateSync();
1322         is $status, 1
1323             or diag $k->error() ;
1324
1325         my $rest;
1326         is $k->read($rest, length($hello) + length($goodbye)),
1327                 length($goodbye)
1328             or diag $k->error() ;
1329         ok $rest eq $goodbye ;
1330
1331         ok $k->close();
1332     }
1333
1334     {
1335         title "inflateSync no FLUSH point";
1336
1337         # create a deflate stream with flush points
1338
1339         my $hello = "I am a HAL 9000 computer" x 2001 ;
1340         my ($x, $err, $answer, $X, $Z, $status);
1341         my $Answer ;
1342
1343         ok ($x = new $CompressClass(\$Answer));
1344         ok $x ;
1345
1346         is $x->write($hello), length($hello);
1347
1348         ok $x->close() ;
1349
1350         my $k;
1351         ($k, $err) = new $UncompressClass(\$Answer, BlockSize => 1);
1352         ok $k ;
1353         cmp_ok $err, '==', Z_OK ;
1354
1355         my $initial;
1356         is $k->read($initial, 1), 1 ;
1357         is $initial, substr($hello, 0, 1);
1358
1359         # Skip to the flush point
1360         $status = $k->inflateSync();
1361         is $status, 0
1362             or diag $k->error() ;
1363
1364         ok $k->close();
1365         is $k->inflateSync(), 0 ;
1366     }
1367
1368     {
1369         title "write tests - invalid data" ;
1370
1371         #my $name1 = "test.gz" ;
1372         #my $lex = new LexFile $name1 ;
1373         my $Answer ;
1374
1375         #ok ! -e $name1, "  File $name1 does not exist";
1376
1377         my @data = (
1378             [ '{ }',         "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1379             [ '[ { } ]',     "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1380             [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ],
1381             [ '[ "" ]',      "${CompressClass}::write: input filename is undef or null string" ],
1382             [ '[ undef ]',   "${CompressClass}::write: input filename is undef or null string" ],
1383             [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ],
1384             #[ "not readable", 'xx' ],
1385             # same filehandle twice, 'xx'
1386            ) ;
1387
1388         foreach my $data (@data)
1389         {
1390             my ($send, $get) = @$data ;
1391             title "${CompressClass}::write( $send )";
1392             my $copy;
1393             eval "\$copy = $send";
1394             my $x = new $CompressClass(\$Answer);
1395             ok $x, "  Created $CompressClass object";
1396             eval { $x->write($copy) } ;
1397             #like $@, "/^$get/", "  error - $get";
1398             like $@, "/not a scalar reference /", "  error - not a scalar reference";
1399         }
1400
1401 #        @data = (
1402 #            [ '[ $name1 ]',  "input file '$name1' does not exist" ],
1403 #            #[ "not readable", 'xx' ],
1404 #            # same filehandle twice, 'xx'
1405 #           ) ;
1406 #
1407 #        foreach my $data (@data)
1408 #        {
1409 #            my ($send, $get) = @$data ;
1410 #            title "${CompressClass}::write( $send )";
1411 #            my $copy;
1412 #            eval "\$copy = $send";
1413 #            my $x = new $CompressClass(\$Answer);
1414 #            ok $x, "  Created $CompressClass object";
1415 #            ok ! $x->write($copy), "  write fails"  ;
1416 #            like $$Error, "/^$get/", "  error - $get";
1417 #        }
1418
1419         #exit;
1420
1421     }
1422
1423
1424 #    sub deepCopy
1425 #    {
1426 #        if (! ref $_[0] || ref $_[0] eq 'SCALAR')
1427 #        {
1428 #            return $_[0] ;
1429 #        }
1430 #
1431 #        if (ref $_[0] eq 'ARRAY')
1432 #        {
1433 #            my @a ;
1434 #            for my $x ( @{ $_[0] })
1435 #            {
1436 #                push @a, deepCopy($x);
1437 #            }
1438 #
1439 #            return \@a ;
1440 #        }
1441 #
1442 #        croak "bad! $_[0]";
1443 #
1444 #    }
1445 #
1446 #    sub deepSubst
1447 #    {
1448 #        #my $data = shift ;
1449 #        my $from = $_[1] ;
1450 #        my $to   = $_[2] ;
1451 #
1452 #        if (! ref $_[0])
1453 #        {
1454 #            $_[0] = $to
1455 #                if $_[0] eq $from ;
1456 #            return ;
1457 #
1458 #        }
1459 #
1460 #        if (ref $_[0] eq 'SCALAR')
1461 #        {
1462 #            $_[0] = \$to
1463 #                if defined ${ $_[0] } && ${ $_[0] } eq $from ;
1464 #            return ;
1465 #
1466 #        }
1467 #
1468 #        if (ref $_[0] eq 'ARRAY')
1469 #        {
1470 #            for my $x ( @{ $_[0] })
1471 #            {
1472 #                deepSubst($x, $from, $to);
1473 #            }
1474 #            return ;
1475 #        }
1476 #        #croak "bad! $_[0]";
1477 #    }
1478
1479 #    {
1480 #        title "More write tests" ;
1481 #
1482 #        my $file1 = "file1" ;
1483 #        my $file2 = "file2" ;
1484 #        my $file3 = "file3" ;
1485 #        my $lex = new LexFile $file1, $file2, $file3 ;
1486 #
1487 #        writeFile($file1, "F1");
1488 #        writeFile($file2, "F2");
1489 #        writeFile($file3, "F3");
1490 #
1491 #        my @data = (
1492 #              [ '""',                                   ""      ],
1493 #              [ 'undef',                                ""      ],
1494 #              [ '"abcd"',                               "abcd"  ],
1495 #
1496 #              [ '\""',                                   ""     ],
1497 #              [ '\undef',                                ""     ],
1498 #              [ '\"abcd"',                               "abcd" ],
1499 #
1500 #              [ '[]',                                    ""     ],
1501 #              [ '[[]]',                                  ""     ],
1502 #              [ '[[[]]]',                                ""     ],
1503 #              [ '[\""]',                                 ""     ],
1504 #              [ '[\undef]',                              ""     ],
1505 #              [ '[\"abcd"]',                             "abcd" ],
1506 #              [ '[\"ab", \"cd"]',                        "abcd" ],
1507 #              [ '[[\"ab"], [\"cd"]]',                    "abcd" ],
1508 #
1509 #              [ '$file1',                                $file1 ],
1510 #              [ '$fh2',                                  "F2"   ],
1511 #              [ '[$file1, \"abc"]',                      "F1abc"],
1512 #              [ '[\"a", $file1, \"bc"]',                 "aF1bc"],
1513 #              [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
1514 #              [ '[\"a", $fh1, \"bc", $file2]',           "aF1bcF2"],
1515 #              [ '[\"a", $fh1, \"bc", $file2, $fh3]',     "aF1bcF2F3"],
1516 #            ) ;
1517 #
1518 #
1519 #        foreach my $data (@data)
1520 #        {
1521 #            my ($send, $get) = @$data ;
1522 #
1523 #            my $fh1 = new IO::File "< $file1" ;
1524 #            my $fh2 = new IO::File "< $file2" ;
1525 #            my $fh3 = new IO::File "< $file3" ;
1526 #
1527 #            title "${CompressClass}::write( $send )";
1528 #            my $copy;
1529 #            eval "\$copy = $send";
1530 #            my $Answer ;
1531 #            my $x = new $CompressClass(\$Answer);
1532 #            ok $x, "  Created $CompressClass object";
1533 #            my $len = length $get;
1534 #            is $x->write($copy), length($get), "  write $len bytes";
1535 #            ok $x->close(), "  close ok" ;
1536 #
1537 #            is myGZreadFile(\$Answer), $get, "  got expected output" ;
1538 #            cmp_ok $$Error, '==', 0, "  no error";
1539 #
1540 #
1541 #        }
1542 #
1543 #    }
1544 }
1545
1546
1547
1548
1549
1550