1b39c5158Smillert 2b39c5158Smillertuse lib 't'; 3b39c5158Smillertuse strict; 4b39c5158Smillertuse warnings; 5b39c5158Smillertuse bytes; 6b39c5158Smillert 7b39c5158Smillertuse Test::More ; 8b39c5158Smillertuse CompTestUtils; 9b39c5158Smillert 10b39c5158Smillertour ($BadPerl, $UncompressClass); 11b39c5158Smillert 12b39c5158SmillertBEGIN 13b39c5158Smillert{ 14b39c5158Smillert plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" ) 15b39c5158Smillert if $] < 5.005 ; 16b39c5158Smillert 17b39c5158Smillert # use Test::NoWarnings, if available 18b39c5158Smillert my $extra = 0 ; 19b39c5158Smillert $extra = 1 20b39c5158Smillert if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 21b39c5158Smillert 22b39c5158Smillert my $tests ; 23b39c5158Smillert $BadPerl = ($] >= 5.006 and $] <= 5.008) ; 24b39c5158Smillert 25b39c5158Smillert if ($BadPerl) { 26b39c5158Smillert $tests = 241 ; 27b39c5158Smillert } 28b39c5158Smillert else { 29b39c5158Smillert $tests = 249 ; 30b39c5158Smillert } 31b39c5158Smillert 32b39c5158Smillert plan tests => $tests + $extra ; 33b39c5158Smillert 34b39c5158Smillert} 35b39c5158Smillert 36b39c5158Smillert 37b39c5158Smillertuse IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END); 38b39c5158Smillert 39b39c5158Smillert 40b39c5158Smillert 41b39c5158Smillertsub myGZreadFile 42b39c5158Smillert{ 43b39c5158Smillert my $filename = shift ; 44b39c5158Smillert my $init = shift ; 45b39c5158Smillert 46b39c5158Smillert 47*256a93a4Safresh1 my $fil = $UncompressClass->can('new')->( $UncompressClass, $filename, 48b39c5158Smillert -Strict => 1, 49b39c5158Smillert -Append => 1 50*256a93a4Safresh1 ); 51b39c5158Smillert 52b39c5158Smillert my $data ; 53b39c5158Smillert $data = $init if defined $init ; 54b39c5158Smillert 1 while $fil->read($data) > 0; 55b39c5158Smillert 56b39c5158Smillert $fil->close ; 57b39c5158Smillert return $data ; 58b39c5158Smillert} 59b39c5158Smillert 60b39c5158Smillertsub run 61b39c5158Smillert{ 62b39c5158Smillert 63b39c5158Smillert my $CompressClass = identify(); 64b39c5158Smillert $UncompressClass = getInverse($CompressClass); 65b39c5158Smillert my $Error = getErrorRef($CompressClass); 66b39c5158Smillert my $UnError = getErrorRef($UncompressClass); 67b39c5158Smillert 68b39c5158Smillert { 69b39c5158Smillert next if $BadPerl ; 70b39c5158Smillert 71b39c5158Smillert 72b39c5158Smillert title "Testing $CompressClass"; 73b39c5158Smillert 74b39c5158Smillert 75b39c5158Smillert my $x ; 76*256a93a4Safresh1 my $gz = $CompressClass->can('new')->( $CompressClass, \$x); 77b39c5158Smillert 78b39c5158Smillert my $buff ; 79b39c5158Smillert 80b39c5158Smillert eval { getc($gz) } ; 81b39c5158Smillert like $@, mkErr("^getc Not Available: File opened only for output"); 82b39c5158Smillert 83b39c5158Smillert eval { read($gz, $buff, 1) } ; 84b39c5158Smillert like $@, mkErr("^read Not Available: File opened only for output"); 85b39c5158Smillert 86b39c5158Smillert eval { <$gz> } ; 87b39c5158Smillert like $@, mkErr("^readline Not Available: File opened only for output"); 88b39c5158Smillert 89b39c5158Smillert } 90b39c5158Smillert 91b39c5158Smillert { 92b39c5158Smillert next if $BadPerl; 93b39c5158Smillert $UncompressClass = getInverse($CompressClass); 94b39c5158Smillert 95b39c5158Smillert title "Testing $UncompressClass"; 96b39c5158Smillert 97b39c5158Smillert my $gc ; 98*256a93a4Safresh1 my $guz = $CompressClass->can('new')->( $CompressClass, \$gc); 99b39c5158Smillert $guz->write("abc") ; 100b39c5158Smillert $guz->close(); 101b39c5158Smillert 102b39c5158Smillert my $x ; 103*256a93a4Safresh1 my $gz = $UncompressClass->can('new')->( $UncompressClass, \$gc); 104b39c5158Smillert 105b39c5158Smillert my $buff ; 106b39c5158Smillert 107b39c5158Smillert eval { print $gz "abc" } ; 108b39c5158Smillert like $@, mkErr("^print Not Available: File opened only for intput"); 109b39c5158Smillert 110b39c5158Smillert eval { printf $gz "fmt", "abc" } ; 111b39c5158Smillert like $@, mkErr("^printf Not Available: File opened only for intput"); 112b39c5158Smillert 113b39c5158Smillert #eval { write($gz, $buff, 1) } ; 114b39c5158Smillert #like $@, mkErr("^write Not Available: File opened only for intput"); 115b39c5158Smillert 116b39c5158Smillert } 117b39c5158Smillert 118b39c5158Smillert { 119b39c5158Smillert $UncompressClass = getInverse($CompressClass); 120b39c5158Smillert 121b39c5158Smillert title "Testing $CompressClass and $UncompressClass"; 122b39c5158Smillert 123b39c5158Smillert 124b39c5158Smillert { 125b39c5158Smillert # Write 126b39c5158Smillert # these tests come almost 100% from IO::String 127b39c5158Smillert 128*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 129b39c5158Smillert 130b39c5158Smillert my $io = $CompressClass->new($name); 131b39c5158Smillert 132b39c5158Smillert is $io->tell(), 0 ; 133b39c5158Smillert 134b39c5158Smillert my $heisan = "Heisan\n"; 135b39c5158Smillert print $io $heisan ; 136b39c5158Smillert 137b39c5158Smillert ok ! $io->eof; 138b39c5158Smillert 139b39c5158Smillert is $io->tell(), length($heisan) ; 140b39c5158Smillert 141b39c5158Smillert print($io "a", "b", "c"); 142b39c5158Smillert 143b39c5158Smillert { 144b39c5158Smillert local($\) = "\n"; 145b39c5158Smillert print $io "d", "e"; 146b39c5158Smillert local($,) = ","; 147b39c5158Smillert print $io "f", "g", "h"; 148b39c5158Smillert } 149b39c5158Smillert 150b39c5158Smillert my $foo = "1234567890"; 151b39c5158Smillert 152b39c5158Smillert ok syswrite($io, $foo, length($foo)) == length($foo) ; 153b39c5158Smillert if ( $] < 5.6 ) 154b39c5158Smillert { is $io->syswrite($foo, length $foo), length $foo } 155b39c5158Smillert else 156b39c5158Smillert { is $io->syswrite($foo), length $foo } 157b39c5158Smillert ok $io->syswrite($foo, length($foo)) == length $foo; 158b39c5158Smillert ok $io->write($foo, length($foo), 5) == 5; 159b39c5158Smillert ok $io->write("xxx\n", 100, -1) == 1; 160b39c5158Smillert 161b39c5158Smillert for (1..3) { 162b39c5158Smillert printf $io "i(%d)", $_; 163b39c5158Smillert $io->printf("[%d]\n", $_); 164b39c5158Smillert } 165b39c5158Smillert select $io; 166b39c5158Smillert print "\n"; 167b39c5158Smillert select STDOUT; 168b39c5158Smillert 169b39c5158Smillert close $io ; 170b39c5158Smillert 171b39c5158Smillert ok $io->eof; 172b39c5158Smillert 173b39c5158Smillert is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" . 174b39c5158Smillert ("1234567890" x 3) . "67890\n" . 175b39c5158Smillert "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n"; 176b39c5158Smillert 177b39c5158Smillert 178b39c5158Smillert } 179b39c5158Smillert 180b39c5158Smillert { 181b39c5158Smillert # Read 182b39c5158Smillert my $str = <<EOT; 183b39c5158SmillertThis is an example 184b39c5158Smillertof a paragraph 185b39c5158Smillert 186b39c5158Smillert 187b39c5158Smillertand a single line. 188b39c5158Smillert 189b39c5158SmillertEOT 190b39c5158Smillert 191*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 192b39c5158Smillert 193*256a93a4Safresh1 my $iow = $CompressClass->can('new')->( $CompressClass, $name ); 194b39c5158Smillert print $iow $str ; 195b39c5158Smillert close $iow; 196b39c5158Smillert 197b39c5158Smillert my @tmp; 198b39c5158Smillert my $buf; 199b39c5158Smillert { 200*256a93a4Safresh1 my $io = $UncompressClass->can('new')->( $UncompressClass, $name ); 201b39c5158Smillert 202b39c5158Smillert ok ! $io->eof, " Not EOF"; 203b39c5158Smillert is $io->tell(), 0, " Tell is 0" ; 204b39c5158Smillert my @lines = <$io>; 205b39c5158Smillert is @lines, 6, " Line is 6" 206b39c5158Smillert or print "# Got " . scalar(@lines) . " lines, expected 6\n" ; 207b39c5158Smillert is $lines[1], "of a paragraph\n" ; 208b39c5158Smillert is join('', @lines), $str ; 209b39c5158Smillert is $., 6; 210b39c5158Smillert is $io->tell(), length($str) ; 211b39c5158Smillert 212b39c5158Smillert ok $io->eof; 213b39c5158Smillert 214b39c5158Smillert ok ! ( defined($io->getline) || 215b39c5158Smillert (@tmp = $io->getlines) || 216b39c5158Smillert defined(<$io>) || 217b39c5158Smillert defined($io->getc) || 218b39c5158Smillert read($io, $buf, 100) != 0) ; 219b39c5158Smillert } 220b39c5158Smillert 221b39c5158Smillert 222b39c5158Smillert { 223b39c5158Smillert local $/; # slurp mode 224b39c5158Smillert my $io = $UncompressClass->new($name); 225b39c5158Smillert ok !$io->eof; 226b39c5158Smillert my @lines = $io->getlines; 227b39c5158Smillert ok $io->eof; 228b39c5158Smillert ok @lines == 1 && $lines[0] eq $str; 229b39c5158Smillert 230b39c5158Smillert $io = $UncompressClass->new($name); 231b39c5158Smillert ok ! $io->eof; 232b39c5158Smillert my $line = <$io>; 233b39c5158Smillert ok $line eq $str; 234b39c5158Smillert ok $io->eof; 235b39c5158Smillert } 236b39c5158Smillert 237b39c5158Smillert { 238b39c5158Smillert local $/ = ""; # paragraph mode 239b39c5158Smillert my $io = $UncompressClass->new($name); 240b39c5158Smillert ok ! $io->eof; 241b39c5158Smillert my @lines = <$io>; 242b39c5158Smillert ok $io->eof; 243b39c5158Smillert ok @lines == 2 244b39c5158Smillert or print "# Got " . scalar(@lines) . " lines, expected 2\n" ; 245b39c5158Smillert ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" 246b39c5158Smillert or print "# $lines[0]\n"; 247b39c5158Smillert ok $lines[1] eq "and a single line.\n\n"; 248b39c5158Smillert } 249b39c5158Smillert 250b39c5158Smillert { 251b39c5158Smillert local $/ = "is"; 252b39c5158Smillert my $io = $UncompressClass->new($name); 253b39c5158Smillert my @lines = (); 254b39c5158Smillert my $no = 0; 255b39c5158Smillert my $err = 0; 256b39c5158Smillert ok ! $io->eof; 257b39c5158Smillert while (<$io>) { 258b39c5158Smillert push(@lines, $_); 259b39c5158Smillert $err++ if $. != ++$no; 260b39c5158Smillert } 261b39c5158Smillert 262b39c5158Smillert ok $err == 0 ; 263b39c5158Smillert ok $io->eof; 264b39c5158Smillert 265b39c5158Smillert ok @lines == 3 266b39c5158Smillert or print "# Got " . scalar(@lines) . " lines, expected 3\n" ; 267b39c5158Smillert ok join("-", @lines) eq 268b39c5158Smillert "This- is- an example\n" . 269b39c5158Smillert "of a paragraph\n\n\n" . 270b39c5158Smillert "and a single line.\n\n"; 271b39c5158Smillert } 272b39c5158Smillert 273b39c5158Smillert 274b39c5158Smillert # Test read 275b39c5158Smillert 276b39c5158Smillert { 277b39c5158Smillert my $io = $UncompressClass->new($name); 278b39c5158Smillert 279b39c5158Smillert 280b39c5158Smillert if (! $BadPerl) { 281b39c5158Smillert eval { read($io, $buf, -1) } ; 282b39c5158Smillert like $@, mkErr("length parameter is negative"); 283b39c5158Smillert } 284b39c5158Smillert 285b39c5158Smillert is read($io, $buf, 0), 0, "Requested 0 bytes" ; 286b39c5158Smillert 287b39c5158Smillert ok read($io, $buf, 3) == 3 ; 288b39c5158Smillert ok $buf eq "Thi"; 289b39c5158Smillert 290b39c5158Smillert ok sysread($io, $buf, 3, 2) == 3 ; 291b39c5158Smillert ok $buf eq "Ths i" 292b39c5158Smillert or print "# [$buf]\n" ;; 293b39c5158Smillert ok ! $io->eof; 294b39c5158Smillert 295b39c5158Smillert # $io->seek(-4, 2); 296b39c5158Smillert # 297b39c5158Smillert # ok ! $io->eof; 298b39c5158Smillert # 299b39c5158Smillert # ok read($io, $buf, 20) == 4 ; 300b39c5158Smillert # ok $buf eq "e.\n\n"; 301b39c5158Smillert # 302b39c5158Smillert # ok read($io, $buf, 20) == 0 ; 303b39c5158Smillert # ok $buf eq ""; 304b39c5158Smillert # 305b39c5158Smillert # ok ! $io->eof; 306b39c5158Smillert } 307b39c5158Smillert 308b39c5158Smillert } 309b39c5158Smillert 310b39c5158Smillert { 311b39c5158Smillert # Read from non-compressed file 312b39c5158Smillert 313b39c5158Smillert my $str = <<EOT; 314b39c5158SmillertThis is an example 315b39c5158Smillertof a paragraph 316b39c5158Smillert 317b39c5158Smillert 318b39c5158Smillertand a single line. 319b39c5158Smillert 320b39c5158SmillertEOT 321b39c5158Smillert 322*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 323b39c5158Smillert 324b39c5158Smillert writeFile($name, $str); 325b39c5158Smillert my @tmp; 326b39c5158Smillert my $buf; 327b39c5158Smillert { 328*256a93a4Safresh1 my $io = $UncompressClass->can('new')->( $UncompressClass, $name, -Transparent => 1 ); 329b39c5158Smillert 330b39c5158Smillert ok defined $io; 331b39c5158Smillert ok ! $io->eof; 332b39c5158Smillert ok $io->tell() == 0 ; 333b39c5158Smillert my @lines = <$io>; 334b39c5158Smillert ok @lines == 6; 335b39c5158Smillert ok $lines[1] eq "of a paragraph\n" ; 336b39c5158Smillert ok join('', @lines) eq $str ; 337b39c5158Smillert ok $. == 6; 338b39c5158Smillert ok $io->tell() == length($str) ; 339b39c5158Smillert 340b39c5158Smillert ok $io->eof; 341b39c5158Smillert 342b39c5158Smillert ok ! ( defined($io->getline) || 343b39c5158Smillert (@tmp = $io->getlines) || 344b39c5158Smillert defined(<$io>) || 345b39c5158Smillert defined($io->getc) || 346b39c5158Smillert read($io, $buf, 100) != 0) ; 347b39c5158Smillert } 348b39c5158Smillert 349b39c5158Smillert 350b39c5158Smillert { 351b39c5158Smillert local $/; # slurp mode 352b39c5158Smillert my $io = $UncompressClass->new($name); 353b39c5158Smillert ok ! $io->eof; 354b39c5158Smillert my @lines = $io->getlines; 355b39c5158Smillert ok $io->eof; 356b39c5158Smillert ok @lines == 1 && $lines[0] eq $str; 357b39c5158Smillert 358b39c5158Smillert $io = $UncompressClass->new($name); 359b39c5158Smillert ok ! $io->eof; 360b39c5158Smillert my $line = <$io>; 361b39c5158Smillert ok $line eq $str; 362b39c5158Smillert ok $io->eof; 363b39c5158Smillert } 364b39c5158Smillert 365b39c5158Smillert { 366b39c5158Smillert local $/ = ""; # paragraph mode 367b39c5158Smillert my $io = $UncompressClass->new($name); 368b39c5158Smillert ok ! $io->eof; 369b39c5158Smillert my @lines = <$io>; 370b39c5158Smillert ok $io->eof; 371b39c5158Smillert ok @lines == 2 372898184e3Ssthen or print "# expected 2 lines, got " . scalar(@lines) . "\n"; 373b39c5158Smillert ok $lines[0] eq "This is an example\nof a paragraph\n\n\n" 374b39c5158Smillert or print "# [$lines[0]]\n" ; 375b39c5158Smillert ok $lines[1] eq "and a single line.\n\n"; 376b39c5158Smillert } 377b39c5158Smillert 378b39c5158Smillert { 379b39c5158Smillert local $/ = "is"; 380b39c5158Smillert my $io = $UncompressClass->new($name); 381b39c5158Smillert my @lines = (); 382b39c5158Smillert my $no = 0; 383b39c5158Smillert my $err = 0; 384b39c5158Smillert ok ! $io->eof; 385b39c5158Smillert while (<$io>) { 386b39c5158Smillert push(@lines, $_); 387b39c5158Smillert $err++ if $. != ++$no; 388b39c5158Smillert } 389b39c5158Smillert 390b39c5158Smillert ok $err == 0 ; 391b39c5158Smillert ok $io->eof; 392b39c5158Smillert 393b39c5158Smillert ok @lines == 3 ; 394b39c5158Smillert ok join("-", @lines) eq 395b39c5158Smillert "This- is- an example\n" . 396b39c5158Smillert "of a paragraph\n\n\n" . 397b39c5158Smillert "and a single line.\n\n"; 398b39c5158Smillert } 399b39c5158Smillert 400b39c5158Smillert 401b39c5158Smillert # Test read 402b39c5158Smillert 403b39c5158Smillert { 404b39c5158Smillert my $io = $UncompressClass->new($name); 405b39c5158Smillert 406b39c5158Smillert ok read($io, $buf, 3) == 3 ; 407b39c5158Smillert ok $buf eq "Thi"; 408b39c5158Smillert 409b39c5158Smillert ok sysread($io, $buf, 3, 2) == 3 ; 410b39c5158Smillert ok $buf eq "Ths i"; 411b39c5158Smillert ok ! $io->eof; 412b39c5158Smillert 413b39c5158Smillert # $io->seek(-4, 2); 414b39c5158Smillert # 415b39c5158Smillert # ok ! $io->eof; 416b39c5158Smillert # 417b39c5158Smillert # ok read($io, $buf, 20) == 4 ; 418b39c5158Smillert # ok $buf eq "e.\n\n"; 419b39c5158Smillert # 420b39c5158Smillert # ok read($io, $buf, 20) == 0 ; 421b39c5158Smillert # ok $buf eq ""; 422b39c5158Smillert # 423b39c5158Smillert # ok ! $io->eof; 424b39c5158Smillert } 425b39c5158Smillert 426b39c5158Smillert 427b39c5158Smillert } 428b39c5158Smillert 429b39c5158Smillert { 430b39c5158Smillert # Vary the length parameter in a read 431b39c5158Smillert 432b39c5158Smillert my $str = <<EOT; 433b39c5158Smillertx 434b39c5158Smillertx 435b39c5158SmillertThis is an example 436b39c5158Smillertof a paragraph 437b39c5158Smillert 438b39c5158Smillert 439b39c5158Smillertand a single line. 440b39c5158Smillert 441b39c5158SmillertEOT 442b39c5158Smillert $str = $str x 100 ; 443b39c5158Smillert 444b39c5158Smillert 445b39c5158Smillert foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1) 446b39c5158Smillert { 447b39c5158Smillert foreach my $trans (0, 1) 448b39c5158Smillert { 449b39c5158Smillert foreach my $append (0, 1) 450b39c5158Smillert { 451b39c5158Smillert title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ; 452b39c5158Smillert 453*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 454b39c5158Smillert 455b39c5158Smillert if ($trans) { 456b39c5158Smillert writeFile($name, $str) ; 457b39c5158Smillert } 458b39c5158Smillert else { 459*256a93a4Safresh1 my $iow = $CompressClass->can('new')->( $CompressClass, $name ); 460b39c5158Smillert print $iow $str ; 461b39c5158Smillert close $iow; 462b39c5158Smillert } 463b39c5158Smillert 464b39c5158Smillert 465b39c5158Smillert my $io = $UncompressClass->new($name, 466b39c5158Smillert -Append => $append, 467b39c5158Smillert -Transparent => $trans); 468b39c5158Smillert 469b39c5158Smillert my $buf; 470b39c5158Smillert 471b39c5158Smillert is $io->tell(), 0; 472b39c5158Smillert 473b39c5158Smillert if ($append) { 474b39c5158Smillert 1 while $io->read($buf, $bufsize) > 0; 475b39c5158Smillert } 476b39c5158Smillert else { 477b39c5158Smillert my $tmp ; 478b39c5158Smillert $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ; 479b39c5158Smillert } 480b39c5158Smillert is length $buf, length $str; 481b39c5158Smillert ok $buf eq $str ; 482b39c5158Smillert ok ! $io->error() ; 483b39c5158Smillert ok $io->eof; 484b39c5158Smillert } 485b39c5158Smillert } 486b39c5158Smillert } 487b39c5158Smillert } 488b39c5158Smillert 489b39c5158Smillert } 490b39c5158Smillert} 491b39c5158Smillert 492b39c5158Smillert1; 493