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