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