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