1 2use strict; 3use warnings; 4use bytes; 5 6use Test::More ; 7 8use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); 9use CompTestUtils; 10 11our ($UncompressClass); 12BEGIN 13{ 14 # use Test::NoWarnings, if available 15 my $extra = 0 ; 16 17 my $st = eval { require Test::NoWarnings ; import Test::NoWarnings; 1; }; 18 $extra = 1 19 if $st ; 20 21 plan(tests => 799 + $extra) ; 22} 23 24sub myGZreadFile 25{ 26 my $filename = shift ; 27 my $init = shift ; 28 29 30 my $fil = new $UncompressClass $filename, 31 -Strict => 0, 32 -Append => 1 33 ; 34 35 my $data = ''; 36 $data = $init if defined $init ; 37 1 while $fil->read($data) > 0; 38 39 $fil->close ; 40 return $data ; 41} 42 43sub run 44{ 45 my $CompressClass = identify(); 46 $UncompressClass = getInverse($CompressClass); 47 my $Error = getErrorRef($CompressClass); 48 my $UnError = getErrorRef($UncompressClass); 49 50 if(1) 51 { 52 53 title "Testing $CompressClass Errors"; 54 55 # Buffer not writable 56 eval qq[\$a = new $CompressClass(\\1) ;] ; 57 like $@, mkEvalErr("^$CompressClass: output buffer is read-only") ; 58 59 my($out, $gz); 60 61 my $x ; 62 $gz = new $CompressClass(\$x); 63 64 foreach my $name (qw(read readline getc)) 65 { 66 eval " \$gz->$name() " ; 67 like $@, mkEvalErr("^$name Not Available: File opened only for output"); 68 } 69 70 eval ' $gz->write({})' ; 71 like $@, mkEvalErr("^${CompressClass}::write: not a scalar reference"); 72 73 eval ' $gz->syswrite("abc", 1, 5)' ; 74 like $@, mkEvalErr("^${CompressClass}::write: offset outside string"); 75 76 eval ' $gz->syswrite("abc", 1, -4)' ; 77 like $@, mkEvalErr("^${CompressClass}::write: offset outside string"), "write outside string"; 78 } 79 80 81 { 82 title "Testing $UncompressClass Errors"; 83 84 my $out = "" ; 85 86 my $lex = new LexFile my $name ; 87 88 ok ! -e $name, " $name does not exist"; 89 90 $a = new $UncompressClass "$name" ; 91 is $a, undef; 92 93 my $gc ; 94 my $guz = new $CompressClass(\$gc); 95 $guz->write("abc") ; 96 $guz->close(); 97 98 my $x ; 99 my $gz = new $UncompressClass(\$gc); 100 101 foreach my $name (qw(print printf write)) 102 { 103 eval " \$gz->$name() " ; 104 like $@, mkEvalErr("^$name Not Available: File opened only for intput"); 105 } 106 107 } 108 109 110 { 111 title "Testing $CompressClass and $UncompressClass"; 112 113 { 114 my ($a, $x, @x) = ("","","") ; 115 116 # Buffer not a scalar reference 117 eval qq[\$a = new $CompressClass \\\@x ;] ; 118 like $@, mkEvalErr("^$CompressClass: output parameter not a filename, filehandle or scalar ref"); 119 120 # Buffer not a scalar reference 121 eval qq[\$a = new $UncompressClass \\\@x ;] ; 122 like $@, mkEvalErr("^$UncompressClass: input parameter not a filename, filehandle, array ref or scalar ref"); 123 } 124 125 foreach my $Type ( $CompressClass, $UncompressClass) 126 { 127 # Check error handling with IO::Compress::Deflate and IO::Uncompress::Inflate 128 129 my ($a, $x, @x) = ("","","") ; 130 131 # Odd number of parameters 132 eval qq[\$a = new $Type "abc", -Output ] ; 133 like $@, mkEvalErr("^$Type: Expected even number of parameters, got 1"); 134 135 # Unknown parameter 136 eval qq[\$a = new $Type "anc", -Fred => 123 ;] ; 137 like $@, mkEvalErr("^$Type: unknown key value\\(s\\) Fred"); 138 139 # no in or out param 140 eval qq[\$a = new $Type ;] ; 141 like $@, mkEvalErr("^$Type: Missing (Input|Output) parameter"); 142 143 } 144 145 146 { 147 # write a very simple compressed file 148 # and read back 149 #======================================== 150 151 152 my $lex = new LexFile my $name ; 153 154 my $hello = <<EOM ; 155hello world 156this is a test 157EOM 158 159 { 160 my $x ; 161 ok $x = new $CompressClass $name ; 162 is $x->autoflush(1), 0, "autoflush"; 163 is $x->autoflush(1), 1, "autoflush"; 164 ok $x->opened(), "opened"; 165 166 ok $x->write($hello), "write" ; 167 ok $x->flush(), "flush"; 168 ok $x->close, "close" ; 169 ok ! $x->opened(), "! opened"; 170 } 171 172 { 173 my $uncomp; 174 ok my $x = new $UncompressClass $name, -Append => 1 ; 175 ok $x->opened(), "opened"; 176 177 my $len ; 178 1 while ($len = $x->read($uncomp)) > 0 ; 179 180 is $len, 0, "read returned 0" 181 or diag $$UnError ; 182 183 ok $x->close ; 184 is $uncomp, $hello ; 185 ok !$x->opened(), "! opened"; 186 } 187 } 188 189 { 190 # write a very simple compressed file 191 # and read back 192 #======================================== 193 194 195 my $lex = new LexFile my $name ; 196 197 my $hello = <<EOM ; 198hello world 199this is a test 200EOM 201 202 { 203 my $x ; 204 ok $x = new $CompressClass $name ; 205 206 is $x->write(''), 0, "Write empty string is ok"; 207 is $x->write(undef), 0, "Write undef is ok"; 208 ok $x->write($hello), "Write ok" ; 209 ok $x->close, "Close ok" ; 210 } 211 212 { 213 my $uncomp; 214 my $x = new $UncompressClass $name ; 215 ok $x, "creates $UncompressClass $name" ; 216 217 my $data = ''; 218 $data .= $uncomp while $x->read($uncomp) > 0 ; 219 220 ok $x->close, "close ok" ; 221 is $data, $hello, "expected output" ; 222 } 223 } 224 225 226 { 227 # write a very simple file with using an IO filehandle 228 # and read back 229 #======================================== 230 231 232 my $lex = new LexFile my $name ; 233 234 my $hello = <<EOM ; 235hello world 236this is a test 237EOM 238 239 { 240 my $fh = new IO::File ">$name" ; 241 ok $fh, "opened file $name ok"; 242 my $x = new $CompressClass $fh ; 243 ok $x, " created $CompressClass $fh" ; 244 245 is $x->fileno(), fileno($fh), "fileno match" ; 246 is $x->write(''), 0, "Write empty string is ok"; 247 is $x->write(undef), 0, "Write undef is ok"; 248 ok $x->write($hello), "write ok" ; 249 ok $x->flush(), "flush"; 250 ok $x->close,"close" ; 251 $fh->close() ; 252 } 253 254 my $uncomp; 255 { 256 my $x ; 257 ok my $fh1 = new IO::File "<$name" ; 258 ok $x = new $UncompressClass $fh1, -Append => 1 ; 259 ok $x->fileno() == fileno $fh1 ; 260 261 1 while $x->read($uncomp) > 0 ; 262 263 ok $x->close ; 264 } 265 266 ok $hello eq $uncomp ; 267 } 268 269 { 270 # write a very simple file with using a glob filehandle 271 # and read back 272 #======================================== 273 274 275 my $lex = new LexFile my $name ; 276 #my $name = "/tmp/fred"; 277 278 my $hello = <<EOM ; 279hello world 280this is a test 281EOM 282 283 { 284 title "$CompressClass: Input from typeglob filehandle"; 285 ok open FH, ">$name" ; 286 287 my $x = new $CompressClass *FH ; 288 ok $x, " create $CompressClass" ; 289 290 is $x->fileno(), fileno(*FH), " fileno" ; 291 is $x->write(''), 0, " Write empty string is ok"; 292 is $x->write(undef), 0, " Write undef is ok"; 293 ok $x->write($hello), " Write ok" ; 294 ok $x->flush(), " Flush"; 295 ok $x->close, " Close" ; 296 close FH; 297 } 298 299 300 my $uncomp; 301 { 302 title "$UncompressClass: Input from typeglob filehandle, append output"; 303 my $x ; 304 ok open FH, "<$name" ; 305 ok $x = new $UncompressClass *FH, -Append => 1, Transparent => 0 306 or diag $$UnError ; 307 is $x->fileno(), fileno FH, " fileno ok" ; 308 309 1 while $x->read($uncomp) > 0 ; 310 311 ok $x->close, " close" ; 312 close FH; 313 } 314 315 is $uncomp, $hello, " expected output" ; 316 } 317 318 { 319 my $lex = new LexFile my $name ; 320 #my $name = "/tmp/fred"; 321 322 my $hello = <<EOM ; 323hello world 324this is a test 325EOM 326 327 { 328 title "Outout to stdout via '-'" ; 329 330 open(SAVEOUT, ">&STDOUT"); 331 my $dummy = fileno SAVEOUT; 332 open STDOUT, ">$name" ; 333 334 my $x = new $CompressClass '-' ; 335 $x->write($hello); 336 $x->close; 337 338 open(STDOUT, ">&SAVEOUT"); 339 340 ok 1, " wrote to stdout" ; 341 } 342 is myGZreadFile($name), $hello, " wrote OK"; 343 #hexDump($name); 344 345 { 346 title "Input from stdin via filename '-'"; 347 348 my $x ; 349 my $uncomp ; 350 my $stdinFileno = fileno(STDIN); 351 # open below doesn't return 1 sometimes on XP 352 open(SAVEIN, "<&STDIN"); 353 ok open(STDIN, "<$name"), " redirect STDIN"; 354 my $dummy = fileno SAVEIN; 355 $x = new $UncompressClass '-', Append => 1, Transparent => 0 356 or diag $$UnError ; 357 ok $x, " created object" ; 358 is $x->fileno(), $stdinFileno, " fileno ok" ; 359 360 1 while $x->read($uncomp) > 0 ; 361 362 ok $x->close, " close" ; 363 open(STDIN, "<&SAVEIN"); 364 is $uncomp, $hello, " expected output" ; 365 } 366 } 367 368 { 369 # write a compressed file to memory 370 # and read back 371 #======================================== 372 373 #my $name = "test.gz" ; 374 my $lex = new LexFile my $name ; 375 376 my $hello = <<EOM ; 377hello world 378this is a test 379EOM 380 381 my $buffer ; 382 { 383 my $x ; 384 ok $x = new $CompressClass(\$buffer) ; 385 386 ok ! defined $x->autoflush(1) ; 387 ok ! defined $x->autoflush(1) ; 388 ok ! defined $x->fileno() ; 389 is $x->write(''), 0, "Write empty string is ok"; 390 is $x->write(undef), 0, "Write undef is ok"; 391 ok $x->write($hello) ; 392 ok $x->flush(); 393 ok $x->close ; 394 395 writeFile($name, $buffer) ; 396 #is anyUncompress(\$buffer), $hello, " any ok"; 397 } 398 399 my $keep = $buffer ; 400 my $uncomp; 401 { 402 my $x ; 403 ok $x = new $UncompressClass(\$buffer, Append => 1) ; 404 405 ok ! defined $x->autoflush(1) ; 406 ok ! defined $x->autoflush(1) ; 407 ok ! defined $x->fileno() ; 408 1 while $x->read($uncomp) > 0 ; 409 410 ok $x->close, "closed" ; 411 } 412 413 is $uncomp, $hello, "got expected uncompressed data" ; 414 ok $buffer eq $keep, "compressed input not changed" ; 415 } 416 417 if ($CompressClass ne 'RawDeflate') 418 { 419 # write empty file 420 #======================================== 421 422 my $buffer = ''; 423 { 424 my $x ; 425 $x = new $CompressClass(\$buffer); 426 ok $x, "new $CompressClass" ; 427 ok $x->close, "close ok" ; 428 429 } 430 431 my $keep = $buffer ; 432 my $uncomp= ''; 433 { 434 my $x ; 435 ok $x = new $UncompressClass(\$buffer, Append => 1) ; 436 437 1 while $x->read($uncomp) > 0 ; 438 439 ok $x->close ; 440 } 441 442 ok $uncomp eq '' ; 443 ok $buffer eq $keep ; 444 445 } 446 447 { 448 # write a larger file 449 #======================================== 450 451 452 my $lex = new LexFile my $name ; 453 454 my $hello = <<EOM ; 455hello world 456this is a test 457EOM 458 459 my $input = '' ; 460 my $contents = '' ; 461 462 { 463 my $x = new $CompressClass $name ; 464 ok $x, " created $CompressClass object"; 465 466 ok $x->write($hello), " write ok" ; 467 $input .= $hello ; 468 ok $x->write("another line"), " write ok" ; 469 $input .= "another line" ; 470 # all characters 471 foreach (0 .. 255) 472 { $contents .= chr int $_ } 473 # generate a long random string 474 foreach (1 .. 5000) 475 { $contents .= chr int rand 256 } 476 477 ok $x->write($contents), " write ok" ; 478 $input .= $contents ; 479 ok $x->close, " close ok" ; 480 } 481 482 ok myGZreadFile($name) eq $input ; 483 my $x = readFile($name) ; 484 #print "length " . length($x) . " \n"; 485 } 486 487 SKIP: 488 { 489 # embed a compressed file in another file 490 #================================ 491 492 skip "zstd doesn't support trailing data", 11 493 if $CompressClass =~ /zstd/i ; 494 495 my $lex = new LexFile my $name ; 496 497 my $hello = <<EOM ; 498hello world 499this is a test 500EOM 501 502 my $header = "header info\n" ; 503 my $trailer = "trailer data\n" ; 504 505 { 506 my $fh ; 507 ok $fh = new IO::File ">$name" ; 508 print $fh $header ; 509 my $x ; 510 ok $x = new $CompressClass $fh, 511 -AutoClose => 0 ; 512 513 ok $x->binmode(); 514 ok $x->write($hello) ; 515 ok $x->close ; 516 print $fh $trailer ; 517 $fh->close() ; 518 } 519 520 my ($fil, $uncomp) ; 521 my $fh1 ; 522 ok $fh1 = new IO::File "<$name" ; 523 # skip leading junk 524 my $line = <$fh1> ; 525 ok $line eq $header ; 526 527 ok my $x = new $UncompressClass $fh1, Append => 1 ; 528 ok $x->binmode(); 529 1 while $x->read($uncomp) > 0 ; 530 531 is $uncomp, $hello ; 532 my $rest ; 533 read($fh1, $rest, 5000); 534 is $x->trailingData() . $rest, $trailer ; 535 #print "# [".$x->trailingData() . "][$rest]\n" ; 536 537 } 538 539 SKIP: 540 { 541 # embed a compressed file in another buffer 542 #================================ 543 544 skip "zstd doesn't support trailing data", 6 545 if $CompressClass =~ /zstd/i ; 546 547 my $hello = <<EOM ; 548hello world 549this is a test 550EOM 551 552 my $trailer = "trailer data" ; 553 554 my $compressed ; 555 556 { 557 ok my $x = new $CompressClass(\$compressed); 558 559 ok $x->write($hello) ; 560 ok $x->close ; 561 $compressed .= $trailer ; 562 } 563 564 my $uncomp; 565 ok my $x = new $UncompressClass(\$compressed, Append => 1) ; 566 1 while $x->read($uncomp) > 0 ; 567 568 ok $uncomp eq $hello ; 569 is $x->trailingData(), $trailer ; 570 571 } 572 573 { 574 # Write 575 # these tests come almost 100% from IO::String 576 577 my $lex = new LexFile my $name ; 578 579 my $io = $CompressClass->new($name); 580 581 is $io->tell(), 0, " tell returns 0"; ; 582 583 my $heisan = "Heisan\n"; 584 $io->print($heisan) ; 585 586 ok ! $io->eof(), " ! eof"; 587 588 is $io->tell(), length($heisan), " tell is " . length($heisan) ; 589 590 $io->print("a", "b", "c"); 591 592 { 593 local($\) = "\n"; 594 $io->print("d", "e"); 595 local($,) = ","; 596 $io->print("f", "g", "h"); 597 } 598 599 { 600 local($\) ; 601 $io->print("D", "E"); 602 local($,) = "."; 603 $io->print("F", "G", "H"); 604 } 605 606 my $foo = "1234567890"; 607 608 is $io->syswrite($foo, length($foo)), length($foo), " syswrite ok" ; 609 if ( $] < 5.6 ) 610 { is $io->syswrite($foo, length $foo), length $foo, " syswrite ok" } 611 else 612 { is $io->syswrite($foo), length $foo, " syswrite ok" } 613 is $io->syswrite($foo, length($foo)), length $foo, " syswrite ok"; 614 is $io->write($foo, length($foo), 5), 5, " write 5"; 615 is $io->write("xxx\n", 100, -1), 1, " write 1"; 616 617 for (1..3) { 618 $io->printf("i(%d)", $_); 619 $io->printf("[%d]\n", $_); 620 } 621 $io->print("\n"); 622 623 $io->close ; 624 625 ok $io->eof(), " eof"; 626 627 is myGZreadFile($name), "Heisan\nabcde\nf,g,h\nDEF.G.H" . 628 ("1234567890" x 3) . "67890\n" . 629 "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n", 630 "myGZreadFile ok"; 631 632 633 } 634 635 { 636 # Read 637 my $str = <<EOT; 638This is an example 639of a paragraph 640 641 642and a single line. 643 644EOT 645 646 my $lex = new LexFile my $name ; 647 648 my %opts = () ; 649 my $iow = new $CompressClass $name, %opts; 650 is $iow->input_line_number, undef; 651 $iow->print($str) ; 652 is $iow->input_line_number, undef; 653 $iow->close ; 654 655 my @tmp; 656 my $buf; 657 { 658 my $io = new $UncompressClass $name ; 659 660 is $., 0; 661 is $io->input_line_number, 0; 662 ok ! $io->eof, "eof"; 663 is $io->tell(), 0, "tell 0" ; 664 #my @lines = <$io>; 665 my @lines = $io->getlines(); 666 is @lines, 6 667 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; 668 is $lines[1], "of a paragraph\n" ; 669 is join('', @lines), $str ; 670 is $., 6; 671 is $io->input_line_number, 6; 672 is $io->tell(), length($str) ; 673 674 ok $io->eof; 675 676 ok ! ( defined($io->getline) || 677 (@tmp = $io->getlines) || 678 defined($io->getline) || 679 defined($io->getc) || 680 $io->read($buf, 100) != 0) ; 681 } 682 683 684 { 685 local $/; # slurp mode 686 my $io = $UncompressClass->new($name); 687 is $., 0, "line 0"; 688 is $io->input_line_number, 0; 689 ok ! $io->eof, "eof"; 690 my @lines = $io->getlines; 691 is $., 1, "line 1"; 692 is $io->input_line_number, 1, "line number 1"; 693 ok $io->eof, "eof" ; 694 ok @lines == 1 && $lines[0] eq $str; 695 696 $io = $UncompressClass->new($name); 697 ok ! $io->eof; 698 my $line = $io->getline(); 699 ok $line eq $str; 700 ok $io->eof; 701 } 702 703 { 704 local $/ = ""; # paragraph mode 705 my $io = $UncompressClass->new($name); 706 is $., 0; 707 is $io->input_line_number, 0; 708 ok ! $io->eof; 709 my @lines = $io->getlines(); 710 is $., 2; 711 is $io->input_line_number, 2; 712 ok $io->eof; 713 ok @lines == 2 714 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; 715 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" 716 or print "# $lines[0]\n"; 717 ok $lines[1] eq "and a single line.\n\n"; 718 } 719 720 { 721 # Record mode 722 my $reclen = 7 ; 723 my $expected_records = int(length($str) / $reclen) 724 + (length($str) % $reclen ? 1 : 0); 725 local $/ = \$reclen; 726 727 my $io = $UncompressClass->new($name); 728 is $., 0; 729 is $io->input_line_number, 0; 730 731 ok ! $io->eof; 732 my @lines = $io->getlines(); 733 is $., $expected_records; 734 is $io->input_line_number, $expected_records; 735 ok $io->eof; 736 is @lines, $expected_records, 737 "Got $expected_records records\n" ; 738 ok $lines[0] eq substr($str, 0, $reclen) 739 or print "# $lines[0]\n"; 740 ok $lines[1] eq substr($str, $reclen, $reclen); 741 } 742 743 { 744 local $/ = "is"; 745 my $io = $UncompressClass->new($name); 746 my @lines = (); 747 my $no = 0; 748 my $err = 0; 749 ok ! $io->eof; 750 while (my $a = $io->getline()) { 751 push(@lines, $a); 752 $err++ if $. != ++$no; 753 } 754 755 ok $err == 0 ; 756 ok $io->eof; 757 758 is $., 3; 759 is $io->input_line_number, 3; 760 ok @lines == 3 761 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; 762 ok join("-", @lines) eq 763 "This- is- an example\n" . 764 "of a paragraph\n\n\n" . 765 "and a single line.\n\n"; 766 } 767 768 769 # Test read 770 771 { 772 my $io = $UncompressClass->new($name); 773 774 775 eval { $io->read(1) } ; 776 like $@, mkErr("buffer parameter is read-only"); 777 778 $buf = "abcd"; 779 is $io->read($buf, 0), 0, "Requested 0 bytes" ; 780 is $buf, "", "Buffer empty"; 781 782 is $io->read($buf, 3), 3 ; 783 is $buf, "Thi"; 784 785 is $io->sysread($buf, 3, 2), 3 ; 786 is $buf, "Ths i" 787 or print "# [$buf]\n" ;; 788 ok ! $io->eof; 789 790 $buf = "ab" ; 791 is $io->read($buf, 3, 4), 3 ; 792 is $buf, "ab" . "\x00" x 2 . "s a" 793 or print "# [$buf]\n" ;; 794 ok ! $io->eof; 795 796 # read the rest of the file 797 $buf = ''; 798 my $remain = length($str) - 9; 799 is $io->read($buf, $remain+1), $remain ; 800 is $buf, substr($str, 9); 801 ok $io->eof; 802 803 $buf = "hello"; 804 is $io->read($buf, 10), 0 ; 805 is $buf, "", "Buffer empty"; 806 ok $io->eof; 807 808 ok $io->close(); 809 $buf = "hello"; 810 is $io->read($buf, 10), 0 ; 811 is $buf, "hello", "Buffer not empty"; 812 ok $io->eof; 813 814 # $io->seek(-4, 2); 815 # 816 # ok ! $io->eof; 817 # 818 # ok read($io, $buf, 20) == 4 ; 819 # ok $buf eq "e.\n\n"; 820 # 821 # ok read($io, $buf, 20) == 0 ; 822 # ok $buf eq ""; 823 # 824 # ok ! $io->eof; 825 } 826 827 } 828 829 { 830 # Read from non-compressed file 831 832 my $str = <<EOT; 833This is an example 834of a paragraph 835 836 837and a single line. 838 839EOT 840 my $lex = new LexFile my $name ; 841 842 writeFile($name, $str); 843 my @tmp; 844 my $buf; 845 { 846 my $io = new $UncompressClass $name, -Transparent => 1 ; 847 848 isa_ok $io, $UncompressClass ; 849 ok ! $io->eof, "eof"; 850 is $io->tell(), 0, "tell == 0" ; 851 my @lines = $io->getlines(); 852 is @lines, 6, "got 6 lines"; 853 ok $lines[1] eq "of a paragraph\n" ; 854 ok join('', @lines) eq $str ; 855 is $., 6; 856 is $io->input_line_number, 6; 857 ok $io->tell() == length($str) ; 858 859 ok $io->eof; 860 861 ok ! ( defined($io->getline) || 862 (@tmp = $io->getlines) || 863 defined($io->getline) || 864 defined($io->getc) || 865 $io->read($buf, 100) != 0) ; 866 } 867 868 869 { 870 local $/; # slurp mode 871 my $io = $UncompressClass->new($name); 872 ok ! $io->eof; 873 my @lines = $io->getlines; 874 is $., 1; 875 is $io->input_line_number, 1; 876 ok $io->eof; 877 ok @lines == 1 && $lines[0] eq $str; 878 879 $io = $UncompressClass->new($name); 880 ok ! $io->eof; 881 my $line = $io->getline; 882 is $., 1; 883 is $io->input_line_number, 1; 884 is $line, $str; 885 ok $io->eof; 886 } 887 888 { 889 local $/ = ""; # paragraph mode 890 my $io = $UncompressClass->new($name); 891 ok ! $io->eof; 892 my @lines = $io->getlines; 893 is $., 2; 894 is $io->input_line_number, 2; 895 ok $io->eof; 896 ok @lines == 2 897 or print "# expected 2 lines, got " . scalar(@lines) . "\n"; 898 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" 899 or print "# [$lines[0]]\n" ; 900 ok $lines[1] eq "and a single line.\n\n"; 901 } 902 903 { 904 # Record mode 905 my $reclen = 7 ; 906 my $expected_records = int(length($str) / $reclen) 907 + (length($str) % $reclen ? 1 : 0); 908 local $/ = \$reclen; 909 910 my $io = $UncompressClass->new($name); 911 is $., 0; 912 is $io->input_line_number, 0; 913 914 ok ! $io->eof; 915 my @lines = $io->getlines(); 916 is $., $expected_records; 917 is $io->input_line_number, $expected_records; 918 ok $io->eof; 919 is @lines, $expected_records, 920 "Got $expected_records records\n" ; 921 ok $lines[0] eq substr($str, 0, $reclen) 922 or print "# $lines[0]\n"; 923 ok $lines[1] eq substr($str, $reclen, $reclen); 924 } 925 926 { 927 local $/ = "is"; 928 my $io = $UncompressClass->new($name); 929 my @lines = (); 930 my $no = 0; 931 my $err = 0; 932 ok ! $io->eof; 933 while (my $a = $io->getline) { 934 push(@lines, $a); 935 $err++ if $. != ++$no; 936 } 937 938 is $., 3; 939 is $io->input_line_number, 3; 940 ok $err == 0 ; 941 ok $io->eof; 942 943 944 ok @lines == 3 ; 945 ok join("-", @lines) eq 946 "This- is- an example\n" . 947 "of a paragraph\n\n\n" . 948 "and a single line.\n\n"; 949 } 950 951 952 # Test Read 953 954 { 955 my $io = $UncompressClass->new($name); 956 957 $buf = "abcd"; 958 is $io->read($buf, 0), 0, "Requested 0 bytes" ; 959 is $buf, "", "Buffer empty"; 960 961 ok $io->read($buf, 3) == 3 ; 962 ok $buf eq "Thi"; 963 964 ok $io->sysread($buf, 3, 2) == 3 ; 965 ok $buf eq "Ths i"; 966 ok ! $io->eof; 967 968 $buf = "ab" ; 969 is $io->read($buf, 3, 4), 3 ; 970 is $buf, "ab" . "\x00" x 2 . "s a" 971 or print "# [$buf]\n" ;; 972 ok ! $io->eof; 973 974 # read the rest of the file 975 $buf = ''; 976 my $remain = length($str) - 9; 977 is $io->read($buf, $remain), $remain ; 978 is $buf, substr($str, 9); 979 ok $io->eof; 980 981 $buf = "hello"; 982 is $io->read($buf, 10), 0 ; 983 is $buf, "", "Buffer empty"; 984 ok $io->eof; 985 986 ok $io->close(); 987 $buf = "hello"; 988 is $io->read($buf, 10), 0 ; 989 is $buf, "hello", "Buffer not empty"; 990 ok $io->eof; 991 992 # $io->seek(-4, 2); 993 # 994 # ok ! $io->eof; 995 # 996 # ok read($io, $buf, 20) == 4 ; 997 # ok $buf eq "e.\n\n"; 998 # 999 # ok read($io, $buf, 20) == 0 ; 1000 # ok $buf eq ""; 1001 # 1002 # ok ! $io->eof; 1003 } 1004 1005 1006 } 1007 1008 { 1009 # Vary the length parameter in a read 1010 1011 my $str = <<EOT; 1012x 1013x 1014This is an example 1015of a paragraph 1016 1017 1018and a single line. 1019 1020EOT 1021 $str = $str x 100 ; 1022 1023 1024 foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1) 1025 { 1026 foreach my $trans (0, 1) 1027 { 1028 foreach my $append (0, 1) 1029 { 1030 title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; 1031 1032 my $lex = new LexFile my $name ; 1033 1034 if ($trans) { 1035 writeFile($name, $str) ; 1036 } 1037 else { 1038 my $iow = new $CompressClass $name; 1039 $iow->print($str) ; 1040 $iow->close ; 1041 } 1042 1043 1044 my $io = $UncompressClass->new($name, 1045 -Append => $append, 1046 -Transparent => $trans); 1047 1048 my $buf; 1049 1050 is $io->tell(), 0; 1051 1052 if ($append) { 1053 1 while $io->read($buf, $bufsize) > 0; 1054 } 1055 else { 1056 my $tmp ; 1057 $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ; 1058 } 1059 is length $buf, length $str; 1060 ok $buf eq $str ; 1061 ok ! $io->error() ; 1062 ok $io->eof; 1063 } 1064 } 1065 } 1066 } 1067 1068 foreach my $file (0, 1) 1069 { 1070 foreach my $trans (0, 1) 1071 { 1072 title "seek tests - file $file trans $trans" ; 1073 1074 my $buffer ; 1075 my $buff ; 1076 my $lex = new LexFile my $name ; 1077 1078 my $first = "beginning" ; 1079 my $last = "the end" ; 1080 1081 if ($trans) 1082 { 1083 $buffer = $first . "\x00" x 10 . $last; 1084 writeFile($name, $buffer); 1085 } 1086 else 1087 { 1088 my $output ; 1089 if ($file) 1090 { 1091 $output = $name ; 1092 } 1093 else 1094 { 1095 $output = \$buffer; 1096 } 1097 1098 my $iow = new $CompressClass $output ; 1099 $iow->print($first) ; 1100 ok $iow->seek(5, SEEK_CUR) ; 1101 ok $iow->tell() == length($first)+5; 1102 ok $iow->seek(0, SEEK_CUR) ; 1103 ok $iow->tell() == length($first)+5; 1104 ok $iow->seek(length($first)+10, SEEK_SET) ; 1105 ok $iow->tell() == length($first)+10; 1106 1107 $iow->print($last) ; 1108 $iow->close ; 1109 } 1110 1111 my $input ; 1112 if ($file) 1113 { 1114 $input = $name ; 1115 } 1116 else 1117 { 1118 $input = \$buffer ; 1119 } 1120 1121 ok myGZreadFile($input) eq $first . "\x00" x 10 . $last ; 1122 1123 my $io = $UncompressClass->new($input, Strict => 1); 1124 ok $io->seek(length($first), SEEK_CUR) 1125 or diag $$UnError ; 1126 ok ! $io->eof; 1127 is $io->tell(), length($first); 1128 1129 ok $io->read($buff, 5) ; 1130 is $buff, "\x00" x 5 ; 1131 is $io->tell(), length($first) + 5; 1132 1133 ok $io->seek(0, SEEK_CUR) ; 1134 my $here = $io->tell() ; 1135 is $here, length($first)+5; 1136 1137 ok $io->seek($here+5, SEEK_SET) ; 1138 is $io->tell(), $here+5 ; 1139 ok $io->read($buff, 100) ; 1140 ok $buff eq $last ; 1141 ok $io->eof; 1142 } 1143 } 1144 1145 { 1146 title "seek error cases" ; 1147 1148 my $b ; 1149 my $a = new $CompressClass(\$b) ; 1150 1151 ok ! $a->error() 1152 or die $a->error() ; 1153 eval { $a->seek(-1, 10) ; }; 1154 like $@, mkErr("^${CompressClass}::seek: unknown value, 10, for whence parameter"); 1155 1156 eval { $a->seek(-1, SEEK_END) ; }; 1157 like $@, mkErr("^${CompressClass}::seek: cannot seek backwards"); 1158 1159 $a->write("fred"); 1160 $a->close ; 1161 1162 1163 my $u = new $UncompressClass(\$b) ; 1164 1165 eval { $u->seek(-1, 10) ; }; 1166 like $@, mkErr("^${UncompressClass}::seek: unknown value, 10, for whence parameter"); 1167 1168 eval { $u->seek(-1, SEEK_END) ; }; 1169 like $@, mkErr("^${UncompressClass}::seek: SEEK_END not allowed"); 1170 1171 eval { $u->seek(-1, SEEK_CUR) ; }; 1172 like $@, mkErr("^${UncompressClass}::seek: cannot seek backwards"); 1173 } 1174 1175 foreach my $fb (qw(filename buffer filehandle)) 1176 { 1177 foreach my $append (0, 1) 1178 { 1179 { 1180 title "$CompressClass -- Append $append, Output to $fb" ; 1181 1182 my $lex = new LexFile my $name ; 1183 1184 my $already = 'already'; 1185 my $buffer = $already; 1186 my $output; 1187 1188 if ($fb eq 'buffer') 1189 { $output = \$buffer } 1190 elsif ($fb eq 'filename') 1191 { 1192 $output = $name ; 1193 writeFile($name, $buffer); 1194 } 1195 elsif ($fb eq 'filehandle') 1196 { 1197 $output = new IO::File ">$name" ; 1198 print $output $buffer; 1199 } 1200 1201 my $a = new $CompressClass($output, Append => $append) ; 1202 ok $a, " Created $CompressClass"; 1203 my $string = "appended"; 1204 $a->write($string); 1205 $a->close ; 1206 1207 my $data ; 1208 if ($fb eq 'buffer') 1209 { 1210 $data = $buffer; 1211 } 1212 else 1213 { 1214 $output->close 1215 if $fb eq 'filehandle'; 1216 $data = readFile($name); 1217 } 1218 1219 if ($append || $fb eq 'filehandle') 1220 { 1221 is substr($data, 0, length($already)), $already, " got prefix"; 1222 substr($data, 0, length($already)) = ''; 1223 } 1224 1225 1226 my $uncomp; 1227 my $x = new $UncompressClass(\$data, Append => 1) ; 1228 ok $x, " created $UncompressClass"; 1229 1230 my $len ; 1231 1 while ($len = $x->read($uncomp)) > 0 ; 1232 1233 $x->close ; 1234 is $uncomp, $string, ' Got uncompressed data' ; 1235 1236 } 1237 } 1238 } 1239 1240 foreach my $type (qw(buffer filename filehandle)) 1241 { 1242 foreach my $good (0, 1) 1243 { 1244 title "$UncompressClass -- InputLength, read from $type, good data => $good"; 1245 1246 my $compressed ; 1247 my $string = "some data"; 1248 my $appended = "append"; 1249 1250 if ($good) 1251 { 1252 my $c = new $CompressClass(\$compressed); 1253 $c->write($string); 1254 $c->close(); 1255 } 1256 else 1257 { 1258 $compressed = $string ; 1259 } 1260 1261 my $comp_len = length $compressed; 1262 $compressed .= $appended; 1263 1264 my $lex = new LexFile my $name ; 1265 my $input ; 1266 writeFile ($name, $compressed); 1267 1268 if ($type eq 'buffer') 1269 { 1270 $input = \$compressed; 1271 } 1272 if ($type eq 'filename') 1273 { 1274 $input = $name; 1275 } 1276 elsif ($type eq 'filehandle') 1277 { 1278 my $fh = new IO::File "<$name" ; 1279 ok $fh, "opened file $name ok"; 1280 $input = $fh ; 1281 } 1282 1283 my $x = new $UncompressClass($input, 1284 InputLength => $comp_len, 1285 Transparent => 1) ; 1286 ok $x, " created $UncompressClass"; 1287 1288 my $len ; 1289 my $output; 1290 $len = $x->read($output, 100); 1291 1292 is $len, length($string); 1293 is $output, $string; 1294 1295 if ($type eq 'filehandle') 1296 { 1297 my $rest ; 1298 $input->read($rest, 1000); 1299 is $rest, $appended; 1300 } 1301 } 1302 1303 1304 } 1305 1306 foreach my $append (0, 1) 1307 { 1308 title "$UncompressClass -- Append $append" ; 1309 1310 my $lex = new LexFile my $name ; 1311 1312 my $string = "appended"; 1313 my $compressed ; 1314 my $c = new $CompressClass(\$compressed); 1315 $c->write($string); 1316 $c->close(); 1317 1318 my $x = new $UncompressClass(\$compressed, Append => $append) ; 1319 ok $x, " created $UncompressClass"; 1320 1321 my $already = 'already'; 1322 my $output = $already; 1323 1324 my $len ; 1325 $len = $x->read($output, 100); 1326 is $len, length($string); 1327 1328 $x->close ; 1329 1330 if ($append) 1331 { 1332 is substr($output, 0, length($already)), $already, " got prefix"; 1333 substr($output, 0, length($already)) = ''; 1334 } 1335 is $output, $string, ' Got uncompressed data' ; 1336 } 1337 1338 1339 foreach my $file (0, 1) 1340 { 1341 foreach my $trans (0, 1) 1342 { 1343 title "ungetc, File $file, Transparent $trans" ; 1344 1345 my $lex = new LexFile my $name ; 1346 1347 my $string = 'abcdeABCDE'; 1348 my $b ; 1349 if ($trans) 1350 { 1351 $b = $string ; 1352 } 1353 else 1354 { 1355 my $a = new $CompressClass(\$b) ; 1356 $a->write($string); 1357 $a->close ; 1358 } 1359 1360 my $from ; 1361 if ($file) 1362 { 1363 writeFile($name, $b); 1364 $from = $name ; 1365 } 1366 else 1367 { 1368 $from = \$b ; 1369 } 1370 1371 my $u = $UncompressClass->new($from, Transparent => 1) ; 1372 my $first; 1373 my $buff ; 1374 1375 # do an ungetc before reading 1376 $u->ungetc("X"); 1377 $first = $u->getc(); 1378 is $first, 'X'; 1379 1380 $first = $u->getc(); 1381 is $first, substr($string, 0,1); 1382 $u->ungetc($first); 1383 $first = $u->getc(); 1384 is $first, substr($string, 0,1); 1385 $u->ungetc($first); 1386 1387 is $u->read($buff, 5), 5 ; 1388 is $buff, substr($string, 0, 5); 1389 1390 $u->ungetc($buff) ; 1391 is $u->read($buff, length($string)), length($string) ; 1392 is $buff, $string; 1393 1394 is $u->read($buff, 1), 0; 1395 ok $u->eof() ; 1396 1397 my $extra = 'extra'; 1398 $u->ungetc($extra); 1399 ok ! $u->eof(); 1400 is $u->read($buff), length($extra) ; 1401 is $buff, $extra; 1402 1403 is $u->read($buff, 1), 0; 1404 ok $u->eof() ; 1405 1406 # getc returns undef on eof 1407 is $u->getc(), undef; 1408 $u->close(); 1409 1410 } 1411 } 1412 1413 { 1414 title "write tests - invalid data" ; 1415 1416 #my $lex = new LexFile my $name1 ; 1417 my($Answer); 1418 1419 #ok ! -e $name1, " File $name1 does not exist"; 1420 1421 my @data = ( 1422 [ '{ }', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 1423 [ '[ { } ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 1424 [ '[ [ { } ] ]', "${CompressClass}::write: input parameter not a filename, filehandle, array ref or scalar ref" ], 1425 [ '[ "" ]', "${CompressClass}::write: input filename is undef or null string" ], 1426 [ '[ undef ]', "${CompressClass}::write: input filename is undef or null string" ], 1427 [ '[ \$Answer ]',"${CompressClass}::write: input and output buffer are identical" ], 1428 #[ "not readable", 'xx' ], 1429 # same filehandle twice, 'xx' 1430 ) ; 1431 1432 foreach my $data (@data) 1433 { 1434 my ($send, $get) = @$data ; 1435 title "${CompressClass}::write( $send )"; 1436 my($copy); 1437 eval "\$copy = $send"; 1438 my $x = new $CompressClass(\$Answer); 1439 ok $x, " Created $CompressClass object"; 1440 eval { $x->write($copy) } ; 1441 #like $@, "/^$get/", " error - $get"; 1442 like $@, "/not a scalar reference /", " error - not a scalar reference"; 1443 } 1444 1445 # @data = ( 1446 # [ '[ $name1 ]', "input file '$name1' does not exist" ], 1447 # #[ "not readable", 'xx' ], 1448 # # same filehandle twice, 'xx' 1449 # ) ; 1450 # 1451 # foreach my $data (@data) 1452 # { 1453 # my ($send, $get) = @$data ; 1454 # title "${CompressClass}::write( $send )"; 1455 # my $copy; 1456 # eval "\$copy = $send"; 1457 # my $x = new $CompressClass(\$Answer); 1458 # ok $x, " Created $CompressClass object"; 1459 # ok ! $x->write($copy), " write fails" ; 1460 # like $$Error, "/^$get/", " error - $get"; 1461 # } 1462 1463 #exit; 1464 1465 } 1466 1467 1468 # sub deepCopy 1469 # { 1470 # if (! ref $_[0] || ref $_[0] eq 'SCALAR') 1471 # { 1472 # return $_[0] ; 1473 # } 1474 # 1475 # if (ref $_[0] eq 'ARRAY') 1476 # { 1477 # my @a ; 1478 # for my $x ( @{ $_[0] }) 1479 # { 1480 # push @a, deepCopy($x); 1481 # } 1482 # 1483 # return \@a ; 1484 # } 1485 # 1486 # croak "bad! $_[0]"; 1487 # 1488 # } 1489 # 1490 # sub deepSubst 1491 # { 1492 # #my $data = shift ; 1493 # my $from = $_[1] ; 1494 # my $to = $_[2] ; 1495 # 1496 # if (! ref $_[0]) 1497 # { 1498 # $_[0] = $to 1499 # if $_[0] eq $from ; 1500 # return ; 1501 # 1502 # } 1503 # 1504 # if (ref $_[0] eq 'SCALAR') 1505 # { 1506 # $_[0] = \$to 1507 # if defined ${ $_[0] } && ${ $_[0] } eq $from ; 1508 # return ; 1509 # 1510 # } 1511 # 1512 # if (ref $_[0] eq 'ARRAY') 1513 # { 1514 # for my $x ( @{ $_[0] }) 1515 # { 1516 # deepSubst($x, $from, $to); 1517 # } 1518 # return ; 1519 # } 1520 # #croak "bad! $_[0]"; 1521 # } 1522 1523 # { 1524 # title "More write tests" ; 1525 # 1526 # my $file1 = "file1" ; 1527 # my $file2 = "file2" ; 1528 # my $file3 = "file3" ; 1529 # my $lex = new LexFile $file1, $file2, $file3 ; 1530 # 1531 # writeFile($file1, "F1"); 1532 # writeFile($file2, "F2"); 1533 # writeFile($file3, "F3"); 1534 # 1535 # my @data = ( 1536 # [ '""', "" ], 1537 # [ 'undef', "" ], 1538 # [ '"abcd"', "abcd" ], 1539 # 1540 # [ '\""', "" ], 1541 # [ '\undef', "" ], 1542 # [ '\"abcd"', "abcd" ], 1543 # 1544 # [ '[]', "" ], 1545 # [ '[[]]', "" ], 1546 # [ '[[[]]]', "" ], 1547 # [ '[\""]', "" ], 1548 # [ '[\undef]', "" ], 1549 # [ '[\"abcd"]', "abcd" ], 1550 # [ '[\"ab", \"cd"]', "abcd" ], 1551 # [ '[[\"ab"], [\"cd"]]', "abcd" ], 1552 # 1553 # [ '$file1', $file1 ], 1554 # [ '$fh2', "F2" ], 1555 # [ '[$file1, \"abc"]', "F1abc"], 1556 # [ '[\"a", $file1, \"bc"]', "aF1bc"], 1557 # [ '[\"a", $fh1, \"bc"]', "aF1bc"], 1558 # [ '[\"a", $fh1, \"bc", $file2]', "aF1bcF2"], 1559 # [ '[\"a", $fh1, \"bc", $file2, $fh3]', "aF1bcF2F3"], 1560 # ) ; 1561 # 1562 # 1563 # foreach my $data (@data) 1564 # { 1565 # my ($send, $get) = @$data ; 1566 # 1567 # my $fh1 = new IO::File "< $file1" ; 1568 # my $fh2 = new IO::File "< $file2" ; 1569 # my $fh3 = new IO::File "< $file3" ; 1570 # 1571 # title "${CompressClass}::write( $send )"; 1572 # my $copy; 1573 # eval "\$copy = $send"; 1574 # my $Answer ; 1575 # my $x = new $CompressClass(\$Answer); 1576 # ok $x, " Created $CompressClass object"; 1577 # my $len = length $get; 1578 # is $x->write($copy), length($get), " write $len bytes"; 1579 # ok $x->close(), " close ok" ; 1580 # 1581 # is myGZreadFile(\$Answer), $get, " got expected output" ; 1582 # cmp_ok $$Error, '==', 0, " no error"; 1583 # 1584 # 1585 # } 1586 # 1587 # } 1588 } 1589 1590 { 1591 # Check can handle empty compressed files 1592 # Test is for rt.cpan #67554 1593 1594 foreach my $type (qw(filename filehandle buffer )) 1595 { 1596 foreach my $append (0, 1) 1597 { 1598 title "$UncompressClass -- empty file read from $type, Append => $append"; 1599 1600 my $appended = "append"; 1601 my $string = "some data"; 1602 my $compressed ; 1603 1604 my $c = new $CompressClass(\$compressed); 1605 $c->close(); 1606 1607 my $comp_len = length $compressed; 1608 $compressed .= $appended if $append && $CompressClass !~ /zstd/i; 1609 1610 my $lex = new LexFile my $name ; 1611 my $input ; 1612 writeFile ($name, $compressed); 1613 1614 if ($type eq 'buffer') 1615 { 1616 $input = \$compressed; 1617 } 1618 elsif ($type eq 'filename') 1619 { 1620 $input = $name; 1621 } 1622 elsif ($type eq 'filehandle') 1623 { 1624 my $fh = new IO::File "<$name" ; 1625 ok $fh, "opened file $name ok"; 1626 $input = $fh ; 1627 } 1628 1629 { 1630 # Check that eof is true immediately after creating the 1631 # uncompression object. 1632 1633 # Check that readline returns undef 1634 1635 my $x = new $UncompressClass $input, Transparent => 0 1636 or diag "$$UnError" ; 1637 isa_ok $x, $UncompressClass; 1638 1639 # should be EOF immediately 1640 is $x->eof(), 1, "eof true"; 1641 1642 is <$x>, undef, "getline is undef"; 1643 1644 is $x->eof(), 1, "eof true"; 1645 } 1646 1647 { 1648 # Check that read returns an empty string 1649 if ($type eq 'filehandle') 1650 { 1651 my $fh = new IO::File "<$name" ; 1652 ok $fh, "opened file $name ok"; 1653 $input = $fh ; 1654 } 1655 1656 my $x = new $UncompressClass $input, Transparent => 0 1657 or diag "$$UnError" ; 1658 isa_ok $x, $UncompressClass; 1659 1660 my $buffer; 1661 is $x->read($buffer), 0, "read 0 bytes" 1662 or diag "read returned $$UnError"; 1663 ok defined $buffer, "buffer is defined"; 1664 is $buffer, "", "buffer is empty string"; 1665 1666 is $x->eof(), 1, "eof true"; 1667 } 1668 1669 { 1670 # Check that read return an empty string in Append Mode 1671 # to empty string 1672 1673 if ($type eq 'filehandle') 1674 { 1675 my $fh = new IO::File "<$name" ; 1676 ok $fh, "opened file $name ok"; 1677 $input = $fh ; 1678 } 1679 my $x = new $UncompressClass $input, Transparent => 0, 1680 Append => 1 1681 or diag "$$UnError" ; 1682 isa_ok $x, $UncompressClass; 1683 1684 my $buffer; 1685 is $x->read($buffer), 0, "read 0 bytes"; 1686 ok defined $buffer, "buffer is defined"; 1687 is $buffer, "", "buffer is empty string"; 1688 1689 is $x->eof(), 1, "eof true"; 1690 } 1691 { 1692 # Check that read return an empty string in Append Mode 1693 # to non-empty string 1694 1695 if ($type eq 'filehandle') 1696 { 1697 my $fh = new IO::File "<$name" ; 1698 ok $fh, "opened file $name ok"; 1699 $input = $fh ; 1700 } 1701 my $x = new $UncompressClass($input, Append => 1 ); 1702 isa_ok $x, $UncompressClass; 1703 1704 my $buffer = "123"; 1705 is $x->read($buffer), 0, "read 0 bytes"; 1706 ok defined $buffer, "buffer is defined"; 1707 is $buffer, "123", "buffer orig string"; 1708 1709 is $x->eof(), 1, "eof true"; 1710 } 1711 } 1712 } 1713 } 1714 1715 { 1716 # Round trip binary data that happens to contain \r\n 1717 # via the filesystem 1718 1719 my $original = join '', map { chr } 0x00 .. 0xff ; 1720 $original .= "data1\r\ndata2\r\ndata3\r\n" ; 1721 1722 1723 title "$UncompressClass -- round trip test"; 1724 1725 my $string = $original; 1726 1727 my $lex = new LexFile( my $name, my $compressed) ; 1728 my $input ; 1729 writeFile ($name, $original); 1730 1731 my $c = new $CompressClass($compressed); 1732 isa_ok $c, $CompressClass; 1733 $c->print($string); 1734 $c->close(); 1735 1736 my $u = new $UncompressClass $compressed, Transparent => 0 1737 or diag "$$UnError" ; 1738 isa_ok $u, $UncompressClass; 1739 my $buffer; 1740 is $u->read($buffer), length($original), "read bytes"; 1741 is $buffer, $original, " round tripped ok"; 1742 1743 1744 } 1745} 1746 17471; 1748