t/lib/compress/generic.pl

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