cpan/IO-Compress/t/compress/oneshot.pl

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