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