ext/Compress/Zlib/t/16oneshot.t

   1 BEGIN {
   2     if ($ENV{PERL_CORE}) {
   3         chdir 't' if -d 't';
   4         @INC = ("../lib", "lib");
   5     }
   6 }
   7
   8 use lib 't';
   9 use strict;
  10 use warnings;
  11 use bytes;
  12
  13 use Test::More ;
  14 use ZlibTestUtils;
  15
  16 BEGIN {
  17     plan(skip_all => "oneshot needs Perl 5.005 or better - you have Perl $]" )
  18         if $] < 5.005 ;
  19
  20
  21     # use Test::NoWarnings, if available
  22     my $extra = 0 ;
  23     $extra = 1
  24         if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };
  25
  26     plan tests => 2462 + $extra ;
  27
  28     use_ok('Compress::Zlib', 2) ;
  29
  30     use_ok('IO::Compress::Gzip', qw($GzipError)) ;
  31     use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
  32
  33     use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
  34     use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
  35
  36     use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
  37     use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
  38
  39     use_ok('IO::Uncompress::AnyInflate', qw(anyinflate $AnyInflateError)) ;
  40
  41 }
  42
  43
  44 # Check zlib_version and ZLIB_VERSION are the same.
  45 is Compress::Zlib::zlib_version, ZLIB_VERSION,
  46     "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
  47
  48
  49
  50 foreach my $bit ('IO::Compress::Gzip',
  51                  'IO::Uncompress::Gunzip',
  52                  'IO::Compress::Deflate',
  53                  'IO::Uncompress::Inflate',
  54                  'IO::Compress::RawDeflate',
  55                  'IO::Uncompress::RawInflate',
  56                  'IO::Uncompress::AnyInflate',
  57                 )
  58 {
  59     my $Error = getErrorRef($bit);
  60     my $Func = getTopFuncRef($bit);
  61     my $TopType = getTopFuncName($bit);
  62
  63     title "Testing $TopType Error Cases";
  64
  65     my $a;
  66     my $x ;
  67
  68     eval { $a = $Func->(\$a => \$x, Fred => 1) ;} ;
  69     like $@, mkErr("^$TopType: unknown key value\\(s\\) Fred"), '  Illegal Parameters';
  70
  71     eval { $a = $Func->() ;} ;
  72     like $@, mkErr("^$TopType: expected at least 1 parameters"), '  No Parameters';
  73
  74     eval { $a = $Func->(\$x, \1) ;} ;
  75     like $@, mkErr("^$TopType: output buffer is read-only"), '  Output is read-only' ;
  76
  77     my $in ;
  78     eval { $a = $Func->($in, \$x) ;} ;
  79     like $@, mkErr("^$TopType: input filename is undef or null string"),
  80         '  Input filename undef' ;
  81
  82     $in = '';
  83     eval { $a = $Func->($in, \$x) ;} ;
  84     like $@, mkErr("^$TopType: input filename is undef or null string"),
  85         '  Input filename empty' ;
  86
  87     my $lex1 = new LexFile my $in1 ;
  88     writeFile($in1, "abc");
  89     my $out = $in1 ;
  90     eval { $a = $Func->($in1, $out) ;} ;
  91     like $@, mkErr("^$TopType: input and output filename are identical"),
  92         '  Input and Output filename are the same';
  93
  94     eval { $a = $Func->(\$in, \$in) ;} ;
  95     like $@, mkErr("^$TopType: input and output buffer are identical"),
  96         '  Input and Output buffer are the same';
  97
  98     my $lex = new LexFile my $out_file ;
  99     open OUT, ">$out_file" ;
 100     eval { $a = $Func->(\*OUT, \*OUT) ;} ;
 101     like $@, mkErr("^$TopType: input and output handle are identical"),
 102         '  Input and Output handle are the same';
 103
 104     close OUT;
 105     is -s $out_file, 0, "  File zero length" ;
 106     {
 107         my %x = () ;
 108         my $object = bless \%x, "someClass" ;
 109
 110         # Buffer not a scalar reference
 111         #eval { $a = $Func->(\$x, \%x) ;} ;
 112         eval { $a = $Func->(\$x, $object) ;} ;
 113         like $@, mkErr("^$TopType: illegal output parameter"),
 114             '  Bad Output Param';
 115
 116
 117         #eval { $a = $Func->(\%x, \$x) ;} ;
 118         eval { $a = $Func->($object, \$x) ;} ;
 119         like $@, mkErr("^$TopType: illegal input parameter"),
 120             '  Bad Input Param';
 121     }
 122
 123     my $filename = 'abc.def';
 124     ok ! -e $filename, "  input file '$filename' does not exist";
 125     $a = $Func->($filename, \$x) ;
 126     is $a, undef, "  $TopType returned undef";
 127     like $$Error, "/^input file '$filename' does not exist\$/", "  input File '$filename' does not exist";
 128
 129     $filename = '/tmp/abd/abc.def';
 130     ok ! -e $filename, "  output File '$filename' does not exist";
 131     $a = $Func->(\$x, $filename) ;
 132     is $a, undef, "  $TopType returned undef";
 133     like $$Error, ("/^(cannot open file '$filename'|input file '$filename' does not exist):/"), "  output File '$filename' does not exist";
 134
 135     $a = $Func->(\$x, '<abc>') ;
 136     is $a, undef, "  $TopType returned undef";
 137     like $$Error, "/Need input fileglob for outout fileglob/",
 138             '  Output fileglob with no input fileglob';
 139
 140     $a = $Func->('<abc)>', '<abc>') ;
 141     is $a, undef, "  $TopType returned undef";
 142     like $$Error, "/Unmatched \\) in input fileglob/",
 143             "  Unmatched ) in input fileglob";
 144 }
 145
 146 foreach my $bit ('IO::Uncompress::Gunzip',
 147                  'IO::Uncompress::Inflate',
 148                  'IO::Uncompress::RawInflate',
 149                  'IO::Uncompress::AnyInflate',
 150                 )
 151 {
 152     my $Error = getErrorRef($bit);
 153     my $Func = getTopFuncRef($bit);
 154     my $TopType = getTopFuncName($bit);
 155
 156     my $data = "mary had a little lamb" ;
 157     my $keep = $data ;
 158
 159     for my $trans ( 0, 1)
 160     {
 161         title "Non-compressed data with $TopType, Transparent => $trans ";
 162         my $a;
 163         my $x ;
 164         my $out = '' ;
 165
 166         $a = $Func->(\$data, \$out, Transparent => $trans) ;
 167
 168         is $data, $keep, "  Input buffer not changed" ;
 169
 170         if ($trans)
 171         {
 172             ok $a, "  $TopType returned true" ;
 173             is $out, $data, "  got expected output" ;
 174             ok ! $$Error, "  no error [$$Error]" ;
 175         }
 176         else
 177         {
 178             ok ! $a, "  $TopType returned false" ;
 179             #like $$Error, '/xxx/', "  error" ;
 180             ok $$Error, "  error is '$$Error'" ;
 181         }
 182     }
 183 }
 184
 185 foreach my $bit ('IO::Compress::Gzip',
 186                  'IO::Compress::Deflate',
 187                  'IO::Compress::RawDeflate',
 188                 )
 189 {
 190     my $Error = getErrorRef($bit);
 191     my $Func = getTopFuncRef($bit);
 192     my $TopType = getTopFuncName($bit);
 193     my $TopTypeInverse = getInverse($bit);
 194     my $FuncInverse = getTopFuncRef($TopTypeInverse);
 195     my $ErrorInverse = getErrorRef($TopTypeInverse);
 196
 197     title "$TopTypeInverse - corrupt data";
 198
 199     my $data = "abcd" x 100 ;
 200     my $out;
 201
 202     ok $Func->(\$data, \$out), "  $TopType ok";
 203
 204     # corrupt the compressed data
 205     #substr($out, -10, 10) = "x" x 10 ;
 206     substr($out, int(length($out)/3), 10) = 'abcdeabcde';
 207
 208     my $result;
 209     ok ! $FuncInverse->(\$out => \$result, Transparent => 0), "  $TopTypeInverse ok";
 210     ok $$ErrorInverse, "  Got error '$$ErrorInverse'" ;
 211
 212     #is $result, $data, "  data ok";
 213
 214     ok ! anyinflate(\$out => \$result, Transparent => 0), "  anyinflate ok";
 215     ok $AnyInflateError, "  Got error '$AnyInflateError'" ;
 216 }
 217
 218
 219 foreach my $bit ('IO::Compress::Gzip',
 220                  'IO::Compress::Deflate',
 221                  'IO::Compress::RawDeflate',
 222                 )
 223 {
 224     my $Error = getErrorRef($bit);
 225     my $Func = getTopFuncRef($bit);
 226     my $TopType = getTopFuncName($bit);
 227     my $TopTypeInverse = getInverse($bit);
 228     my $FuncInverse = getTopFuncRef($TopTypeInverse);
 229
 230     for my $append ( 1, 0 )
 231     {
 232         my $already = '';
 233         $already = 'abcde' if $append ;
 234
 235         for my $buffer ( undef, '', "abcde" )
 236         {
 237
 238             my $disp_content = defined $buffer ? $buffer : '<undef>' ;
 239
 240             my $keep = $buffer;
 241             my $out_file = "abcde.out";
 242             my $in_file = "abcde.in";
 243
 244             {
 245                 title "$TopType - From Buff to Buff content '$disp_content' Append $append" ;
 246
 247                 my $output = $already;
 248                 ok &$Func(\$buffer, \$output, Append => $append), '  Compressed ok' ;
 249
 250                 is $keep, $buffer, "  Input buffer not changed" ;
 251                 my $got = anyUncompress(\$output, $already);
 252                 $got = undef if ! defined $buffer && $got eq '' ;
 253                 is $got, $buffer, "  Uncompressed matches original";
 254
 255             }
 256
 257             {
 258                 title "$TopType - From Buff to Array Ref content '$disp_content' Append $append" ;
 259
 260                 my @output = ('first') ;
 261                 ok &$Func(\$buffer, \@output, Append => $append), '  Compressed ok' ;
 262
 263                 is $output[0], 'first', "  Array[0] unchanged";
 264                 is $keep, $buffer, "  Input buffer not changed" ;
 265                 my $got = anyUncompress($output[1]);
 266                 $got = undef if ! defined $buffer && $got eq '' ;
 267                 is $got, $buffer, "  Uncompressed matches original";
 268             }
 269
 270             {
 271                 title "$TopType - From Array Ref to Array Ref content '$disp_content' Append $append" ;
 272
 273                 my @output = ('first') ;
 274                 my @input = ( \$buffer);
 275                 ok &$Func(\@input, \@output, Append => $append), '  Compressed ok' ;
 276
 277                 is $output[0], 'first', "  Array[0] unchanged";
 278                 is $keep, $buffer, "  Input buffer not changed" ;
 279                 my $got = anyUncompress($output[1]);
 280                 $got = undef if ! defined $buffer && $got eq '' ;
 281                 is $got, $buffer, "  Uncompressed matches original";
 282
 283             }
 284
 285             {
 286                 title "$TopType - From Buff to Filename content '$disp_content' Append $append" ;
 287
 288                 my $lex = new LexFile($out_file) ;
 289                 ok ! -e $out_file, "  Output file does not exist";
 290                 writeFile($out_file, $already);
 291
 292                 ok &$Func(\$buffer, $out_file, Append => $append), '  Compressed ok' ;
 293
 294                 ok -e $out_file, "  Created output file";
 295                 my $got = anyUncompress($out_file, $already);
 296                 $got = undef if ! defined $buffer && $got eq '' ;
 297                 is $got, $buffer, "  Uncompressed matches original";
 298             }
 299
 300             {
 301                 title "$TopType - From Buff to Handle content '$disp_content' Append $append" ;
 302
 303                 my $lex = new LexFile($out_file) ;
 304
 305                 ok ! -e $out_file, "  Output file does not exist";
 306                 writeFile($out_file, $already);
 307                 my $of = new IO::File ">>$out_file" ;
 308                 ok $of, "  Created output filehandle" ;
 309
 310                 ok &$Func(\$buffer, $of, AutoClose => 1, Append => $append), '  Compressed ok' ;
 311
 312                 ok -e $out_file, "  Created output file";
 313                 my $got = anyUncompress($out_file, $already);
 314                 $got = undef if ! defined $buffer && $got eq '' ;
 315                 is $got, $buffer, "  Uncompressed matches original";
 316             }
 317
 318
 319             {
 320                 title "$TopType - From Filename to Filename content '$disp_content' Append $append" ;
 321
 322                 my $lex = new LexFile($in_file, $out_file) ;
 323                 writeFile($in_file, $buffer);
 324
 325                 ok ! -e $out_file, "  Output file does not exist";
 326                 writeFile($out_file, $already);
 327
 328                 ok &$Func($in_file => $out_file, Append => $append), '  Compressed ok' ;
 329
 330                 ok -e $out_file, "  Created output file";
 331                 my $got = anyUncompress($out_file, $already);
 332                 $got = undef if ! defined $buffer && $got eq '' ;
 333                 is $got, $buffer, "  Uncompressed matches original";
 334
 335             }
 336
 337             {
 338                 title "$TopType - From Filename to Handle content '$disp_content' Append $append" ;
 339
 340                 my $lex = new LexFile($in_file, $out_file) ;
 341                 writeFile($in_file, $buffer);
 342
 343                 ok ! -e $out_file, "  Output file does not exist";
 344                 writeFile($out_file, $already);
 345                 my $out = new IO::File ">>$out_file" ;
 346
 347                 ok &$Func($in_file, $out, AutoClose => 1, Append => $append), '  Compressed ok' ;
 348
 349                 ok -e $out_file, "  Created output file";
 350                 my $got = anyUncompress($out_file, $already);
 351                 $got = undef if ! defined $buffer && $got eq '' ;
 352                 is $got, $buffer, "  Uncompressed matches original";
 353
 354             }
 355
 356             {
 357                 title "$TopType - From Filename to Buffer content '$disp_content' Append $append" ;
 358
 359                 my $lex = new LexFile($in_file, $out_file) ;
 360                 writeFile($in_file, $buffer);
 361
 362                 my $out = $already;
 363
 364                 ok &$Func($in_file => \$out, Append => $append), '  Compressed ok' ;
 365
 366                 my $got = anyUncompress(\$out, $already);
 367                 $got = undef if ! defined $buffer && $got eq '' ;
 368                 is $got, $buffer, "  Uncompressed matches original";
 369
 370             }
 371
 372             {
 373                 title "$TopType - From Handle to Filename content '$disp_content' Append $append" ;
 374
 375                 my $lex = new LexFile($in_file, $out_file) ;
 376                 writeFile($in_file, $buffer);
 377                 my $in = new IO::File "<$in_file" ;
 378
 379                 ok ! -e $out_file, "  Output file does not exist";
 380                 writeFile($out_file, $already);
 381
 382                 ok &$Func($in, $out_file, Append => $append), '  Compressed ok'
 383                     or diag "error is $GzipError" ;
 384
 385                 ok -e $out_file, "  Created output file";
 386                 my $got = anyUncompress($out_file, $already);
 387                 $got = undef if ! defined $buffer && $got eq '' ;
 388                 is $buffer, $got, "  Uncompressed matches original";
 389
 390             }
 391
 392             {
 393                 title "$TopType - From Handle to Handle content '$disp_content' Append $append" ;
 394
 395                 my $lex = new LexFile($in_file, $out_file) ;
 396                 writeFile($in_file, $buffer);
 397                 my $in = new IO::File "<$in_file" ;
 398
 399                 ok ! -e $out_file, "  Output file does not exist";
 400                 writeFile($out_file, $already);
 401                 my $out = new IO::File ">>$out_file" ;
 402
 403                 ok &$Func($in, $out, AutoClose => 1, Append => $append), '  Compressed ok' ;
 404
 405                 ok -e $out_file, "  Created output file";
 406                 my $got = anyUncompress($out_file, $already);
 407                 $got = undef if ! defined $buffer && $got eq '' ;
 408                 is $buffer, $got, "  Uncompressed matches original";
 409
 410             }
 411
 412             {
 413                 title "$TopType - From Handle to Buffer content '$disp_content' Append $append" ;
 414
 415                 my $lex = new LexFile($in_file, $out_file) ;
 416                 writeFile($in_file, $buffer);
 417                 my $in = new IO::File "<$in_file" ;
 418
 419                 my $out = $already ;
 420
 421                 ok &$Func($in, \$out, Append => $append), '  Compressed ok' ;
 422
 423                 my $got = anyUncompress(\$out, $already);
 424                 $got = undef if ! defined $buffer && $got eq '' ;
 425                 is $buffer, $got, "  Uncompressed matches original";
 426
 427             }
 428
 429             {
 430                 title "$TopType - From stdin (via '-') to Buffer content '$disp_content' Append $append" ;
 431
 432                 my $lex = new LexFile($in_file, $out_file) ;
 433                 writeFile($in_file, $buffer);
 434
 435                    open(SAVEIN, "<&STDIN");
 436                 my $dummy = fileno SAVEIN ;
 437                 ok open(STDIN, "<$in_file"), "  redirect STDIN";
 438
 439                 my $out = $already;
 440
 441                 ok &$Func('-', \$out, Append => $append), '  Compressed ok'
 442                     or diag $$Error ;
 443
 444                    open(STDIN, "<&SAVEIN");
 445
 446                 my $got = anyUncompress(\$out, $already);
 447                 $got = undef if ! defined $buffer && $got eq '' ;
 448                 is $buffer, $got, "  Uncompressed matches original";
 449
 450             }
 451
 452         }
 453     }
 454 }
 455
 456 foreach my $bit ('IO::Compress::Gzip',
 457                  'IO::Compress::Deflate',
 458                  'IO::Compress::RawDeflate',
 459                 )
 460 {
 461     my $Error = getErrorRef($bit);
 462     my $Func = getTopFuncRef($bit);
 463     my $TopType = getTopFuncName($bit);
 464
 465     my $TopTypeInverse = getInverse($bit);
 466     my $FuncInverse = getTopFuncRef($TopTypeInverse);
 467
 468     my ($file1, $file2) = ("file1", "file2");
 469     my $lex = new LexFile($file1, $file2) ;
 470
 471     writeFile($file1, "data1");
 472     writeFile($file2, "data2");
 473     my $of = new IO::File "<$file1" ;
 474     ok $of, "  Created output filehandle" ;
 475
 476     my @input = (   undef, "", $file2, \undef, \'', \"abcde", $of) ;
 477     my @expected = ("", "", $file2, "", "", "abcde", "data1");
 478     my @uexpected = ("", "", "data2", "", "", "abcde", "data1");
 479
 480     my @keep = @input ;
 481
 482     {
 483         title "$TopType - From Array Ref to Array Ref" ;
 484
 485         my @output = ('first') ;
 486         ok &$Func(\@input, \@output, AutoClose => 0), '  Compressed ok' ;
 487
 488         is $output[0], 'first', "  Array[0] unchanged";
 489
 490         is_deeply \@input, \@keep, "  Input array not changed" ;
 491         my @got = shift @output;
 492         foreach (@output) { push @got, anyUncompress($_) }
 493
 494         is_deeply \@got, ['first', @expected], "  Got Expected uncompressed data";
 495
 496     }
 497
 498     {
 499         title "$TopType - From Array Ref to Buffer" ;
 500
 501         # rewind the filehandle
 502         $of->open("<$file1") ;
 503
 504         my $output  ;
 505         ok &$Func(\@input, \$output, AutoClose => 0), '  Compressed ok' ;
 506
 507         my $got = anyUncompress(\$output);
 508
 509         is $got, join('', @expected), "  Got Expected uncompressed data";
 510     }
 511
 512     {
 513         title "$TopType - From Array Ref to Filename" ;
 514
 515         my ($file3) = ("file3");
 516         my $lex = new LexFile($file3) ;
 517
 518         # rewind the filehandle
 519         $of->open("<$file1") ;
 520
 521         my $output  ;
 522         ok &$Func(\@input, $file3, AutoClose => 0), '  Compressed ok' ;
 523
 524         my $got = anyUncompress($file3);
 525
 526         is $got, join('', @expected), "  Got Expected uncompressed data";
 527     }
 528
 529     {
 530         title "$TopType - From Array Ref to Filehandle" ;
 531
 532         my ($file3) = ("file3");
 533         my $lex = new LexFile($file3) ;
 534
 535         my $fh3 = new IO::File ">$file3";
 536
 537         # rewind the filehandle
 538         $of->open("<$file1") ;
 539
 540         my $output  ;
 541         ok &$Func(\@input, $fh3, AutoClose => 0), '  Compressed ok' ;
 542
 543         $fh3->close();
 544
 545         my $got = anyUncompress($file3);
 546
 547         is $got, join('', @expected), "  Got Expected uncompressed data";
 548     }
 549 }
 550
 551 foreach my $bit ('IO::Compress::Gzip',
 552                  'IO::Compress::Deflate',
 553                  'IO::Compress::RawDeflate',
 554                 )
 555 {
 556     my $Error = getErrorRef($bit);
 557     my $Func = getTopFuncRef($bit);
 558     my $TopType = getTopFuncName($bit);
 559
 560     my $TopTypeInverse = getInverse($bit);
 561     my $FuncInverse = getTopFuncRef($TopTypeInverse);
 562
 563     my @inFiles  = map { "in$_.tmp"  } 1..4;
 564     my @outFiles = map { "out$_.tmp" } 1..4;
 565     my $lex = new LexFile(@inFiles, @outFiles);
 566
 567     writeFile($_, "data $_") foreach @inFiles ;
 568
 569     {
 570         title "$TopType - Hash Ref: to filename" ;
 571
 572         my $output ;
 573         ok &$Func( { $inFiles[0] => $outFiles[0],
 574                      $inFiles[1] => $outFiles[1],
 575                      $inFiles[2] => $outFiles[2] } ), '  Compressed ok' ;
 576
 577         foreach (0 .. 2)
 578         {
 579             my $got = anyUncompress($outFiles[$_]);
 580             is $got, "data $inFiles[$_]", "  Uncompressed $_ matches original";
 581         }
 582     }
 583
 584     {
 585         title "$TopType - Hash Ref: to buffer" ;
 586
 587         my @buffer ;
 588         ok &$Func( { $inFiles[0] => \$buffer[0],
 589                      $inFiles[1] => \$buffer[1],
 590                      $inFiles[2] => \$buffer[2] } ), '  Compressed ok' ;
 591
 592         foreach (0 .. 2)
 593         {
 594             my $got = anyUncompress(\$buffer[$_]);
 595             is $got, "data $inFiles[$_]", "  Uncompressed $_ matches original";
 596         }
 597     }
 598
 599     {
 600         title "$TopType - Hash Ref: to undef" ;
 601
 602         my @buffer ;
 603         my %hash = ( $inFiles[0] => undef,
 604                      $inFiles[1] => undef,
 605                      $inFiles[2] => undef,
 606                  );
 607
 608         ok &$Func( \%hash ), '  Compressed ok' ;
 609
 610         foreach (keys %hash)
 611         {
 612             my $got = anyUncompress(\$hash{$_});
 613             is $got, "data $_", "  Uncompressed $_ matches original";
 614         }
 615     }
 616
 617     {
 618         title "$TopType - Filename to Hash Ref" ;
 619
 620         my %output ;
 621         ok &$Func( $inFiles[0] => \%output), '  Compressed ok' ;
 622
 623         is keys %output, 1, "  one pair in hash" ;
 624         my ($k, $v) = each %output;
 625         is $k, $inFiles[0], "  key is '$inFiles[0]'";
 626         my $got = anyUncompress($v);
 627         is $got, "data $inFiles[0]", "  Uncompressed matches original";
 628     }
 629
 630     {
 631         title "$TopType - File Glob to Hash Ref" ;
 632
 633         my %output ;
 634         ok &$Func( '<in*.tmp>' => \%output), '  Compressed ok' ;
 635
 636         is keys %output, 4, "  four pairs in hash" ;
 637         foreach my $fil (@inFiles)
 638         {
 639             ok exists $output{$fil}, "  key '$fil' exists" ;
 640             my $got = anyUncompress($output{$fil});
 641             is $got, "data $fil", "  Uncompressed matches original";
 642         }
 643     }
 644
 645
 646 #    if (0)
 647 #    {
 648 #        title "$TopType - Hash Ref to Array Ref" ;
 649 #
 650 #        my @output = ('first') ;
 651 #        ok &$Func( { \@input, \@output } , AutoClose => 0), '  Compressed ok' ;
 652 #
 653 #        is $output[0], 'first', "  Array[0] unchanged";
 654 #
 655 #        is_deeply \@input, \@keep, "  Input array not changed" ;
 656 #        my @got = shift @output;
 657 #        foreach (@output) { push @got, anyUncompress($_) }
 658 #
 659 #        is_deeply \@got, ['first', @expected], "  Got Expected uncompressed data";
 660 #
 661 #    }
 662 #
 663 #    if (0)
 664 #    {
 665 #        title "$TopType - From Array Ref to Buffer" ;
 666 #
 667 #        # rewind the filehandle
 668 #        $of->open("<$file1") ;
 669 #
 670 #        my $output  ;
 671 #        ok &$Func(\@input, \$output, AutoClose => 0), '  Compressed ok' ;
 672 #
 673 #        my $got = anyUncompress(\$output);
 674 #
 675 #        is $got, join('', @expected), "  Got Expected uncompressed data";
 676 #    }
 677 #
 678 #    if (0)
 679 #    {
 680 #        title "$TopType - From Array Ref to Filename" ;
 681 #
 682 #        my ($file3) = ("file3");
 683 #        my $lex = new LexFile($file3) ;
 684 #
 685 #        # rewind the filehandle
 686 #        $of->open("<$file1") ;
 687 #
 688 #        my $output  ;
 689 #        ok &$Func(\@input, $file3, AutoClose => 0), '  Compressed ok' ;
 690 #
 691 #        my $got = anyUncompress($file3);
 692 #
 693 #        is $got, join('', @expected), "  Got Expected uncompressed data";
 694 #    }
 695 #
 696 #    if (0)
 697 #    {
 698 #        title "$TopType - From Array Ref to Filehandle" ;
 699 #
 700 #        my ($file3) = ("file3");
 701 #        my $lex = new LexFile($file3) ;
 702 #
 703 #        my $fh3 = new IO::File ">$file3";
 704 #
 705 #        # rewind the filehandle
 706 #        $of->open("<$file1") ;
 707 #
 708 #        my $output  ;
 709 #        ok &$Func(\@input, $fh3, AutoClose => 0), '  Compressed ok' ;
 710 #
 711 #        $fh3->close();
 712 #
 713 #        my $got = anyUncompress($file3);
 714 #
 715 #        is $got, join('', @expected), "  Got Expected uncompressed data";
 716 #    }
 717 }
 718
 719 foreach my $bit ('IO::Compress::Gzip',
 720                  'IO::Compress::Deflate',
 721                  'IO::Compress::RawDeflate',
 722                 )
 723 {
 724     my $Error = getErrorRef($bit);
 725     my $Func = getTopFuncRef($bit);
 726     my $TopType = getTopFuncName($bit);
 727
 728     for my $files ( [qw(a1)], [qw(a1 a2 a3)] )
 729     {
 730
 731         my $tmpDir1 = 'tmpdir1';
 732         my $tmpDir2 = 'tmpdir2';
 733         my $lex = new LexDir($tmpDir1, $tmpDir2) ;
 734
 735         mkdir $tmpDir1, 0777;
 736         mkdir $tmpDir2, 0777;
 737
 738         ok   -d $tmpDir1, "  Temp Directory $tmpDir1 exists";
 739         #ok ! -d $tmpDir2, "  Temp Directory $tmpDir2 does not exist";
 740
 741         my @files = map { "$tmpDir1/$_.tmp" } @$files ;
 742         foreach (@files) { writeFile($_, "abc $_") }
 743
 744         my @expected = map { "abc $_" } @files ;
 745         my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
 746
 747         {
 748             title "$TopType - From FileGlob to FileGlob files [@$files]" ;
 749
 750             ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), '  Compressed ok'
 751                 or diag $$Error ;
 752
 753             my @copy = @expected;
 754             for my $file (@outFiles)
 755             {
 756                 is anyUncompress($file), shift @copy, "  got expected from $file" ;
 757             }
 758
 759             is @copy, 0, "  got all files";
 760         }
 761
 762         {
 763             title "$TopType - From FileGlob to Array files [@$files]" ;
 764
 765             my @buffer = ('first') ;
 766             ok &$Func("<$tmpDir1/a*.tmp>" => \@buffer), '  Compressed ok'
 767                 or diag $$Error ;
 768
 769             is shift @buffer, 'first';
 770
 771             my @copy = @expected;
 772             for my $buffer (@buffer)
 773             {
 774                 is anyUncompress($buffer), shift @copy, "  got expected " ;
 775             }
 776
 777             is @copy, 0, "  got all files";
 778         }
 779
 780         {
 781             title "$TopType - From FileGlob to Buffer files [@$files]" ;
 782
 783             my $buffer ;
 784             ok &$Func("<$tmpDir1/a*.tmp>" => \$buffer), '  Compressed ok'
 785                 or diag $$Error ;
 786
 787             #hexDump(\$buffer);
 788
 789             my $got = anyUncompress([ \$buffer, MultiStream => 1 ]);
 790
 791             is $got, join("", @expected), "  got expected" ;
 792         }
 793
 794         {
 795             title "$TopType - From FileGlob to Filename files [@$files]" ;
 796
 797             my $filename = "abcde";
 798             my $lex = new LexFile($filename) ;
 799
 800             ok &$Func("<$tmpDir1/a*.tmp>" => $filename), '  Compressed ok'
 801                 or diag $$Error ;
 802
 803             #hexDump(\$buffer);
 804
 805             my $got = anyUncompress([$filename, MultiStream => 1]);
 806
 807             is $got, join("", @expected), "  got expected" ;
 808         }
 809
 810         {
 811             title "$TopType - From FileGlob to Filehandle files [@$files]" ;
 812
 813             my $filename = "abcde";
 814             my $lex = new LexFile($filename) ;
 815             my $fh = new IO::File ">$filename";
 816
 817             ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1), '  Compressed ok'
 818                 or diag $$Error ;
 819
 820             #hexDump(\$buffer);
 821
 822             my $got = anyUncompress([$filename, MultiStream => 1]);
 823
 824             is $got, join("", @expected), "  got expected" ;
 825         }
 826     }
 827
 828 }
 829
 830 foreach my $bit ('IO::Uncompress::Gunzip',
 831                  'IO::Uncompress::Inflate',
 832                  'IO::Uncompress::RawInflate',
 833                  'IO::Uncompress::AnyInflate',
 834                 )
 835 {
 836     my $Error = getErrorRef($bit);
 837     my $Func = getTopFuncRef($bit);
 838     my $TopType = getTopFuncName($bit);
 839
 840     my $buffer = "abcde" ;
 841     my $buffer2 = "ABCDE" ;
 842     my $keep_orig = $buffer;
 843
 844     my $comp = compressBuffer($TopType, $buffer) ;
 845     my $comp2 = compressBuffer($TopType, $buffer2) ;
 846     my $keep_comp = $comp;
 847
 848     my $incumbent = "incumbent data" ;
 849
 850     for my $append (0, 1)
 851     {
 852         my $expected = $buffer ;
 853         $expected = $incumbent . $buffer if $append ;
 854
 855         {
 856             title "$TopType - From Buff to Buff, Append($append)" ;
 857
 858             my $output ;
 859             $output = $incumbent if $append ;
 860             ok &$Func(\$comp, \$output, Append => $append), '  Uncompressed ok' ;
 861
 862             is $keep_comp, $comp, "  Input buffer not changed" ;
 863             is $output, $expected, "  Uncompressed matches original";
 864         }
 865
 866         {
 867             title "$TopType - From Buff to Array, Append($append)" ;
 868
 869             my @output = ('first');
 870             #$output = $incumbent if $append ;
 871             ok &$Func(\$comp, \@output, Append => $append), '  Uncompressed ok' ;
 872
 873             is $keep_comp, $comp, "  Input buffer not changed" ;
 874             is $output[0], 'first', "  Uncompressed matches original";
 875             is ${ $output[1] }, $buffer, "  Uncompressed matches original"
 876                 or diag $output[1] ;
 877             is @output, 2, "  only 2 elements in the array" ;
 878         }
 879
 880         {
 881             title "$TopType - From Buff to Filename, Append($append)" ;
 882
 883             my $out_file = "abcde";
 884             my $lex = new LexFile($out_file) ;
 885             if ($append)
 886               { writeFile($out_file, $incumbent) }
 887             else
 888               { ok ! -e $out_file, "  Output file does not exist" }
 889
 890             ok &$Func(\$comp, $out_file, Append => $append), '  Uncompressed ok' ;
 891
 892             ok -e $out_file, "  Created output file";
 893             my $content = readFile($out_file) ;
 894
 895             is $keep_comp, $comp, "  Input buffer not changed" ;
 896             is $content, $expected, "  Uncompressed matches original";
 897         }
 898
 899         {
 900             title "$TopType - From Buff to Handle, Append($append)" ;
 901
 902             my $out_file = "abcde";
 903             my $lex = new LexFile($out_file) ;
 904             my $of ;
 905             if ($append) {
 906                 writeFile($out_file, $incumbent) ;
 907                 $of = new IO::File "+< $out_file" ;
 908             }
 909             else {
 910                 ok ! -e $out_file, "  Output file does not exist" ;
 911                 $of = new IO::File "> $out_file" ;
 912             }
 913             isa_ok $of, 'IO::File', '  $of' ;
 914
 915             ok &$Func(\$comp, $of, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
 916
 917             ok -e $out_file, "  Created output file";
 918             my $content = readFile($out_file) ;
 919
 920             is $keep_comp, $comp, "  Input buffer not changed" ;
 921             is $content, $expected, "  Uncompressed matches original";
 922         }
 923
 924         {
 925             title "$TopType - From Filename to Filename, Append($append)" ;
 926
 927             my $out_file = "abcde.out";
 928             my $in_file = "abcde.in";
 929             my $lex = new LexFile($in_file, $out_file) ;
 930             if ($append)
 931               { writeFile($out_file, $incumbent) }
 932             else
 933               { ok ! -e $out_file, "  Output file does not exist" }
 934
 935             writeFile($in_file, $comp);
 936
 937             ok &$Func($in_file, $out_file, Append => $append), '  Uncompressed ok' ;
 938
 939             ok -e $out_file, "  Created output file";
 940             my $content = readFile($out_file) ;
 941
 942             is $keep_comp, $comp, "  Input buffer not changed" ;
 943             is $content, $expected, "  Uncompressed matches original";
 944         }
 945
 946         {
 947             title "$TopType - From Filename to Handle, Append($append)" ;
 948
 949             my $out_file = "abcde.out";
 950             my $in_file = "abcde.in";
 951             my $lex = new LexFile($in_file, $out_file) ;
 952             my $out ;
 953             if ($append) {
 954                 writeFile($out_file, $incumbent) ;
 955                 $out = new IO::File "+< $out_file" ;
 956             }
 957             else {
 958                 ok ! -e $out_file, "  Output file does not exist" ;
 959                 $out = new IO::File "> $out_file" ;
 960             }
 961             isa_ok $out, 'IO::File', '  $out' ;
 962
 963             writeFile($in_file, $comp);
 964
 965             ok &$Func($in_file, $out, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
 966
 967             ok -e $out_file, "  Created output file";
 968             my $content = readFile($out_file) ;
 969
 970             is $keep_comp, $comp, "  Input buffer not changed" ;
 971             is $content, $expected, "  Uncompressed matches original";
 972         }
 973
 974         {
 975             title "$TopType - From Filename to Buffer, Append($append)" ;
 976
 977             my $in_file = "abcde.in";
 978             my $lex = new LexFile($in_file) ;
 979             writeFile($in_file, $comp);
 980
 981             my $output ;
 982             $output = $incumbent if $append ;
 983
 984             ok &$Func($in_file, \$output, Append => $append), '  Uncompressed ok' ;
 985
 986             is $keep_comp, $comp, "  Input buffer not changed" ;
 987             is $output, $expected, "  Uncompressed matches original";
 988         }
 989
 990         {
 991             title "$TopType - From Handle to Filename, Append($append)" ;
 992
 993             my $out_file = "abcde.out";
 994             my $in_file = "abcde.in";
 995             my $lex = new LexFile($in_file, $out_file) ;
 996             if ($append)
 997               { writeFile($out_file, $incumbent) }
 998             else
 999               { ok ! -e $out_file, "  Output file does not exist" }
1000
1001             writeFile($in_file, $comp);
1002             my $in = new IO::File "<$in_file" ;
1003
1004             ok &$Func($in, $out_file, Append => $append), '  Uncompressed ok' ;
1005
1006             ok -e $out_file, "  Created output file";
1007             my $content = readFile($out_file) ;
1008
1009             is $keep_comp, $comp, "  Input buffer not changed" ;
1010             is $content, $expected, "  Uncompressed matches original";
1011         }
1012
1013         {
1014             title "$TopType - From Handle to Handle, Append($append)" ;
1015
1016             my $out_file = "abcde.out";
1017             my $in_file = "abcde.in";
1018             my $lex = new LexFile($in_file, $out_file) ;
1019             my $out ;
1020             if ($append) {
1021                 writeFile($out_file, $incumbent) ;
1022                 $out = new IO::File "+< $out_file" ;
1023             }
1024             else {
1025                 ok ! -e $out_file, "  Output file does not exist" ;
1026                 $out = new IO::File "> $out_file" ;
1027             }
1028             isa_ok $out, 'IO::File', '  $out' ;
1029
1030             writeFile($in_file, $comp);
1031             my $in = new IO::File "<$in_file" ;
1032
1033             ok &$Func($in, $out, Append => $append, AutoClose => 1), '  Uncompressed ok' ;
1034
1035             ok -e $out_file, "  Created output file";
1036             my $content = readFile($out_file) ;
1037
1038             is $keep_comp, $comp, "  Input buffer not changed" ;
1039             is $content, $expected, "  Uncompressed matches original";
1040         }
1041
1042         {
1043             title "$TopType - From Filename to Buffer, Append($append)" ;
1044
1045             my $in_file = "abcde.in";
1046             my $lex = new LexFile($in_file) ;
1047             writeFile($in_file, $comp);
1048             my $in = new IO::File "<$in_file" ;
1049
1050             my $output ;
1051             $output = $incumbent if $append ;
1052
1053             ok &$Func($in, \$output, Append => $append), '  Uncompressed ok' ;
1054
1055             is $keep_comp, $comp, "  Input buffer not changed" ;
1056             is $output, $expected, "  Uncompressed matches original";
1057         }
1058
1059         {
1060             title "$TopType - From stdin (via '-') to Buffer content, Append($append) " ;
1061
1062             my $in_file = "abcde.in";
1063             my $lex = new LexFile($in_file) ;
1064             writeFile($in_file, $comp);
1065
1066                open(SAVEIN, "<&STDIN");
1067             my $dummy = fileno SAVEIN ;
1068             ok open(STDIN, "<$in_file"), "  redirect STDIN";
1069
1070             my $output ;
1071             $output = $incumbent if $append ;
1072
1073             ok &$Func('-', \$output, Append => $append), '  Uncompressed ok'
1074                 or diag $$Error ;
1075
1076                open(STDIN, "<&SAVEIN");
1077
1078             is $keep_comp, $comp, "  Input buffer not changed" ;
1079             is $output, $expected, "  Uncompressed matches original";
1080         }
1081     }
1082
1083     {
1084         title "$TopType - From Handle to Buffer, InputLength" ;
1085
1086         my $out_file = "abcde.out";
1087         my $in_file = "abcde.in";
1088         my $lex = new LexFile($in_file, $out_file) ;
1089         my $out ;
1090
1091         my $expected = $buffer ;
1092         my $appended = 'appended';
1093         my $len_appended = length $appended;
1094         writeFile($in_file, $comp . $appended . $comp . $appended) ;
1095         my $in = new IO::File "<$in_file" ;
1096
1097         ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), '  Uncompressed ok' ;
1098
1099         is $out, $expected, "  Uncompressed matches original";
1100
1101         my $buff;
1102         is $in->read($buff, $len_appended), $len_appended, "  Length of Appended data ok";
1103         is $buff, $appended, "  Appended data ok";
1104
1105         $out = '';
1106         ok &$Func($in, \$out, Transparent => 0, InputLength => length $comp), '  Uncompressed ok' ;
1107
1108         is $out, $expected, "  Uncompressed matches original";
1109
1110         $buff = '';
1111         is $in->read($buff, $len_appended), $len_appended, "  Length of Appended data ok";
1112         is $buff, $appended, "  Appended data ok";
1113     }
1114
1115     for my $stdin ('-', *STDIN) # , \*STDIN)
1116     {
1117         title "$TopType - From stdin (via $stdin) to Buffer content, InputLength" ;
1118
1119         my $lex = new LexFile my $in_file ;
1120         my $expected = $buffer ;
1121         my $appended = 'appended';
1122         my $len_appended = length $appended;
1123         writeFile($in_file, $comp . $appended ) ;
1124
1125            open(SAVEIN, "<&STDIN");
1126         my $dummy = fileno SAVEIN ;
1127         ok open(STDIN, "<$in_file"), "  redirect STDIN";
1128
1129         my $output ;
1130
1131         ok &$Func($stdin, \$output, Transparent => 0, InputLength => length $comp), '  Uncompressed ok'
1132             or diag $$Error ;
1133
1134         my $buff ;
1135         is read(STDIN, $buff, $len_appended), $len_appended, "  Length of Appended data ok";
1136
1137         is $output, $expected, "  Uncompressed matches original";
1138         is $buff, $appended, "  Appended data ok";
1139
1140           open(STDIN, "<&SAVEIN");
1141     }
1142 }
1143
1144 foreach my $bit ('IO::Uncompress::Gunzip',
1145                  'IO::Uncompress::Inflate',
1146                  'IO::Uncompress::RawInflate',
1147                  'IO::Uncompress::AnyInflate',
1148                 )
1149 {
1150     # TODO -- Add Append mode tests
1151
1152     my $Error = getErrorRef($bit);
1153     my $Func = getTopFuncRef($bit);
1154     my $TopType = getTopFuncName($bit);
1155
1156     my $buffer = "abcde" ;
1157     my $keep_orig = $buffer;
1158
1159
1160     my $null = compressBuffer($TopType, "") ;
1161     my $undef = compressBuffer($TopType, undef) ;
1162     my $comp = compressBuffer($TopType, $buffer) ;
1163     my $keep_comp = $comp;
1164
1165     my $incumbent = "incumbent data" ;
1166
1167     #my ($file1, $file2) = ("file1", "file2");
1168     my $lex = new LexFile(my $file1, my $file2) ;
1169
1170     writeFile($file1, compressBuffer($TopType,"data1"));
1171     writeFile($file2, compressBuffer($TopType,"data2"));
1172
1173     my $of = new IO::File "<$file1" ;
1174     ok $of, "  Created output filehandle" ;
1175
1176     my @input    = ($file2, \$undef, \$null, \$comp, $of) ;
1177     my @expected = ('data2', '',      '',    'abcde', 'data1');
1178
1179     my @keep = @input ;
1180
1181     {
1182         title "$TopType - From ArrayRef to Buffer" ;
1183
1184         my $output  ;
1185         ok &$Func(\@input, \$output, AutoClose => 0), '  UnCompressed ok' ;
1186
1187         is $output, join('', @expected)
1188     }
1189
1190     {
1191         title "$TopType - From ArrayRef to Filename" ;
1192
1193         my $output  = 'abc';
1194         my $lex = new LexFile $output;
1195         $of->open("<$file1") ;
1196
1197         ok &$Func(\@input, $output, AutoClose => 0), '  UnCompressed ok' ;
1198
1199         is readFile($output), join('', @expected)
1200     }
1201
1202     {
1203         title "$TopType - From ArrayRef to Filehandle" ;
1204
1205         my $output  = 'abc';
1206         my $lex = new LexFile $output;
1207         my $fh = new IO::File ">$output" ;
1208         $of->open("<$file1") ;
1209
1210         ok &$Func(\@input, $fh, AutoClose => 0), '  UnCompressed ok' ;
1211         $fh->close;
1212
1213         is readFile($output), join('', @expected)
1214     }
1215
1216     {
1217         title "$TopType - From Array Ref to Array Ref" ;
1218
1219         my @output = (\'first') ;
1220         $of->open("<$file1") ;
1221         ok &$Func(\@input, \@output, AutoClose => 0), '  UnCompressed ok' ;
1222
1223         is_deeply \@input, \@keep, "  Input array not changed" ;
1224         is_deeply [map { defined $$_ ? $$_ : "" } @output],
1225                   ['first', @expected],
1226                   "  Got Expected uncompressed data";
1227
1228     }
1229 }
1230
1231 foreach my $bit ('IO::Uncompress::Gunzip',
1232                  'IO::Uncompress::Inflate',
1233                  'IO::Uncompress::RawInflate',
1234                  'IO::Uncompress::AnyInflate',
1235                 )
1236 {
1237     # TODO -- Add Append mode tests
1238
1239     my $Error = getErrorRef($bit);
1240     my $Func = getTopFuncRef($bit);
1241     my $TopType = getTopFuncName($bit);
1242
1243     my $tmpDir1 = 'tmpdir1';
1244     my $tmpDir2 = 'tmpdir2';
1245     my $lex = new LexDir($tmpDir1, $tmpDir2) ;
1246
1247     mkdir $tmpDir1, 0777;
1248     mkdir $tmpDir2, 0777;
1249
1250     ok   -d $tmpDir1, "  Temp Directory $tmpDir1 exists";
1251     #ok ! -d $tmpDir2, "  Temp Directory $tmpDir2 does not exist";
1252
1253     my @files = map { "$tmpDir1/$_.tmp" } qw( a1 a2 a3) ;
1254     foreach (@files) { writeFile($_, compressBuffer($TopType, "abc $_")) }
1255
1256     my @expected = map { "abc $_" } @files ;
1257     my @outFiles = map { s/$tmpDir1/$tmpDir2/; $_ } @files ;
1258
1259     {
1260         title "$TopType - From FileGlob to FileGlob" ;
1261
1262         ok &$Func("<$tmpDir1/a*.tmp>" => "<$tmpDir2/a#1.tmp>"), '  UnCompressed ok'
1263             or diag $$Error ;
1264
1265         my @copy = @expected;
1266         for my $file (@outFiles)
1267         {
1268             is readFile($file), shift @copy, "  got expected from $file" ;
1269         }
1270
1271         is @copy, 0, "  got all files";
1272     }
1273
1274     {
1275         title "$TopType - From FileGlob to Arrayref" ;
1276
1277         my @output = (\'first');
1278         ok &$Func("<$tmpDir1/a*.tmp>" => \@output), '  UnCompressed ok'
1279             or diag $$Error ;
1280
1281         my @copy = ('first', @expected);
1282         for my $data (@output)
1283         {
1284             is $$data, shift @copy, "  got expected data" ;
1285         }
1286
1287         is @copy, 0, "  got all files";
1288     }
1289
1290     {
1291         title "$TopType - From FileGlob to Buffer" ;
1292
1293         my $output ;
1294         ok &$Func("<$tmpDir1/a*.tmp>" => \$output), '  UnCompressed ok'
1295             or diag $$Error ;
1296
1297         is $output, join('', @expected), "  got expected uncompressed data";
1298     }
1299
1300     {
1301         title "$TopType - From FileGlob to Filename" ;
1302
1303         my $output = 'abc' ;
1304         my $lex = new LexFile $output ;
1305         ok ! -e $output, "  $output does not exist" ;
1306         ok &$Func("<$tmpDir1/a*.tmp>" => $output), '  UnCompressed ok'
1307             or diag $$Error ;
1308
1309         ok -e $output, "  $output does exist" ;
1310         is readFile($output), join('', @expected), "  got expected uncompressed data";
1311     }
1312
1313     {
1314         title "$TopType - From FileGlob to Filehandle" ;
1315
1316         my $output = 'abc' ;
1317         my $lex = new LexFile $output ;
1318         my $fh = new IO::File ">$output" ;
1319         ok &$Func("<$tmpDir1/a*.tmp>" => $fh, AutoClose => 1), '  UnCompressed ok'
1320             or diag $$Error ;
1321
1322         ok -e $output, "  $output does exist" ;
1323         is readFile($output), join('', @expected), "  got expected uncompressed data";
1324     }
1325
1326 }
1327
1328 foreach my $TopType ('IO::Compress::Gzip::gzip',
1329                      'IO::Compress::Deflate',
1330                      'IO::Compress::RawDeflate',
1331                      # TODO -- add the inflate classes
1332                     )
1333 {
1334     my $Error = getErrorRef($TopType);
1335     my $Func = getTopFuncRef($TopType);
1336     my $Name = getTopFuncName($TopType);
1337
1338     title "More write tests" ;
1339
1340     my $lex = new LexFile(my $file1, my $file2, my $file3) ;
1341
1342     writeFile($file1, "F1");
1343     writeFile($file2, "F2");
1344     writeFile($file3, "F3");
1345
1346     my @data = (
1347           [ '[]',                                    ""     ],
1348           [ '[\""]',                                 ""     ],
1349           [ '[\undef]',                              ""     ],
1350           [ '[\"abcd"]',                             "abcd" ],
1351           [ '[\"ab", \"cd"]',                        "abcd" ],
1352
1353           [ '$fh2',                                  "F2"   ],
1354           [ '[\"a", $fh1, \"bc"]',                   "aF1bc"],
1355         ) ;
1356
1357
1358     foreach my $data (@data)
1359     {
1360         my ($send, $get) = @$data ;
1361
1362         my $fh1 = new IO::File "< $file1" ;
1363         my $fh2 = new IO::File "< $file2" ;
1364         my $fh3 = new IO::File "< $file3" ;
1365
1366         title "$send";
1367         my $copy;
1368         eval "\$copy = $send";
1369         my $Answer ;
1370         ok &$Func($copy, \$Answer), "  $Name ok";
1371
1372         my $got = anyUncompress(\$Answer);
1373         is $got, $get, "  got expected output" ;
1374         ok ! $$Error,  "  no error"
1375             or diag "Error is $$Error";
1376
1377     }
1378
1379     title "Array Input Error tests" ;
1380
1381     @data = (
1382                '[[]]',
1383                '[[[]]]',
1384                '[[\"ab"], [\"cd"]]',
1385             ) ;
1386
1387
1388     foreach my $send (@data)
1389     {
1390         my $fh1 = new IO::File "< $file1" ;
1391         my $fh2 = new IO::File "< $file2" ;
1392         my $fh3 = new IO::File "< $file3" ;
1393
1394         title "$send";
1395         my $copy;
1396         eval "\$copy = $send";
1397         my $Answer ;
1398         ok ! &$Func($copy, \$Answer), "  $Name fails";
1399
1400         is $$Error, "unknown input parameter", "  got error message";
1401
1402     }
1403 }
1404
1405 sub gzipGetHeader
1406 {
1407     my $in = shift;
1408     my $content = shift ;
1409     my %opts = @_ ;
1410
1411     my $out ;
1412     my $got ;
1413
1414     ok IO::Compress::Gzip::gzip($in, \$out, %opts), "  gzip ok" ;
1415     ok IO::Uncompress::Gunzip::gunzip(\$out, \$got), "  gunzip ok"
1416         or diag $GunzipError ;
1417     is $got, $content, "  got expected content" ;
1418
1419     my $gunz = new IO::Uncompress::Gunzip \$out, Strict => 0
1420         or diag "GunzipError is $IO::Uncompress::Gunzip::GunzipError" ;
1421     ok $gunz, "  Created IO::Uncompress::Gunzip object";
1422     my $hdr = $gunz->getHeaderInfo();
1423     ok $hdr, "  got Header info";
1424     my $uncomp ;
1425     ok $gunz->read($uncomp), " read ok" ;
1426     is $uncomp, $content, "  got expected content";
1427     ok $gunz->close, "  closed ok" ;
1428
1429     return $hdr ;
1430
1431 }
1432
1433 {
1434     title "Check gzip header default NAME & MTIME settings" ;
1435
1436     my $lex = new LexFile my $file1;
1437
1438     my $content = "hello ";
1439     my $hdr ;
1440     my $mtime ;
1441
1442     writeFile($file1, $content);
1443     $mtime = (stat($file1))[8];
1444     # make sure that the gzip file isn't created in the same
1445     # second as the input file
1446     sleep 3 ;
1447     $hdr = gzipGetHeader($file1, $content);
1448
1449     is $hdr->{Name}, $file1, "  Name is '$file1'";
1450     is $hdr->{Time}, $mtime, "  Time is ok";
1451
1452     title "Override Name" ;
1453
1454     writeFile($file1, $content);
1455     $mtime = (stat($file1))[8];
1456     sleep 3 ;
1457     $hdr = gzipGetHeader($file1, $content, Name => "abcde");
1458
1459     is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
1460     is $hdr->{Time}, $mtime, "  Time is ok";
1461
1462     title "Override Time" ;
1463
1464     writeFile($file1, $content);
1465     $hdr = gzipGetHeader($file1, $content, Time => 1234);
1466
1467     is $hdr->{Name}, $file1, "  Name is '$file1'" ;
1468     is $hdr->{Time}, 1234,  "  Time is 1234";
1469
1470     title "Override Name and Time" ;
1471
1472     writeFile($file1, $content);
1473     $hdr = gzipGetHeader($file1, $content, Time => 4321, Name => "abcde");
1474
1475     is $hdr->{Name}, "abcde", "  Name is 'abcde'" ;
1476     is $hdr->{Time}, 4321, "  Time is 4321";
1477
1478     title "Filehandle doesn't have default Name or Time" ;
1479     my $fh = new IO::File "< $file1"
1480         or diag "Cannot open '$file1': $!\n" ;
1481     sleep 3 ;
1482     my $before = time ;
1483     $hdr = gzipGetHeader($fh, $content);
1484     my $after = time ;
1485
1486     ok ! defined $hdr->{Name}, "  Name is undef";
1487     cmp_ok $hdr->{Time}, '>=', $before, "  Time is ok";
1488     cmp_ok $hdr->{Time}, '<=', $after, "  Time is ok";
1489
1490     $fh->close;
1491
1492     title "Buffer doesn't have default Name or Time" ;
1493     my $buffer = $content;
1494     $before = time ;
1495     $hdr = gzipGetHeader(\$buffer, $content);
1496     $after = time ;
1497
1498     ok ! defined $hdr->{Name}, "  Name is undef";
1499     cmp_ok $hdr->{Time}, '>=', $before, "  Time is ok";
1500     cmp_ok $hdr->{Time}, '<=', $after, "  Time is ok";
1501 }
1502
1503 # TODO add more error cases
1504