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