1b39c5158Smillert 2b39c5158Smillertuse lib 't'; 3b39c5158Smillertuse strict; 4b39c5158Smillertuse warnings; 5b39c5158Smillertuse bytes; 6b39c5158Smillert 7b39c5158Smillertuse Test::More ; 8b39c5158Smillertuse CompTestUtils; 9b39c5158Smillert 10b39c5158SmillertBEGIN 11b39c5158Smillert{ 12b39c5158Smillert plan(skip_all => "Destroy not supported in Perl $]") 13b39c5158Smillert if $] == 5.008 || ( $] >= 5.005 && $] < 5.006) ; 14b39c5158Smillert 15b39c5158Smillert # use Test::NoWarnings, if available 16b39c5158Smillert my $extra = 0 ; 17b39c5158Smillert $extra = 1 18b39c5158Smillert if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 19b39c5158Smillert 20b39c5158Smillert plan tests => 15 + $extra ; 21b39c5158Smillert 22b39c5158Smillert use_ok('IO::File') ; 23b39c5158Smillert} 24b39c5158Smillert 25b39c5158Smillertsub run 26b39c5158Smillert{ 27b39c5158Smillert 28b39c5158Smillert my $CompressClass = identify(); 29b39c5158Smillert my $UncompressClass = getInverse($CompressClass); 30b39c5158Smillert my $Error = getErrorRef($CompressClass); 31b39c5158Smillert my $UnError = getErrorRef($UncompressClass); 32b39c5158Smillert 33b39c5158Smillert title "Testing $CompressClass"; 34b39c5158Smillert 35b39c5158Smillert { 36b39c5158Smillert # Check that the class destructor will call close 37b39c5158Smillert 38*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 39b39c5158Smillert 40b39c5158Smillert my $hello = <<EOM ; 41b39c5158Smillerthello world 42b39c5158Smillertthis is a test 43b39c5158SmillertEOM 44b39c5158Smillert 45b39c5158Smillert 46b39c5158Smillert { 47*256a93a4Safresh1 ok my $x = $CompressClass->can('new')->( $CompressClass, $name, -AutoClose => 1 ); 48b39c5158Smillert 49b39c5158Smillert ok $x->write($hello) ; 50b39c5158Smillert } 51b39c5158Smillert 52b39c5158Smillert is anyUncompress($name), $hello ; 53b39c5158Smillert } 54b39c5158Smillert 55b39c5158Smillert { 56b39c5158Smillert # Tied filehandle destructor 57b39c5158Smillert 58b39c5158Smillert 59*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 60b39c5158Smillert 61b39c5158Smillert my $hello = <<EOM ; 62b39c5158Smillerthello world 63b39c5158Smillertthis is a test 64b39c5158SmillertEOM 65b39c5158Smillert 66*256a93a4Safresh1 my $fh = IO::File->new( "> $name" ); 67b39c5158Smillert 68b39c5158Smillert { 69*256a93a4Safresh1 ok my $x = $CompressClass->can('new')->( $CompressClass, $fh, -AutoClose => 1 ); 70b39c5158Smillert 71b39c5158Smillert $x->write($hello) ; 72b39c5158Smillert } 73b39c5158Smillert 74b39c5158Smillert ok anyUncompress($name) eq $hello ; 75b39c5158Smillert } 76b39c5158Smillert 77b39c5158Smillert { 78b39c5158Smillert title "Testing DESTROY doesn't clobber \$! etc "; 79b39c5158Smillert 80*256a93a4Safresh1 my $lex = LexFile->new( my $name ); 81b39c5158Smillert 82b39c5158Smillert my $out; 83b39c5158Smillert my $result; 84b39c5158Smillert 85b39c5158Smillert { 86*256a93a4Safresh1 ok my $z = $CompressClass->can('new')->( $CompressClass, $name ); 87b39c5158Smillert $z->write("abc") ; 88b39c5158Smillert $! = 22 ; 89b39c5158Smillert 90b39c5158Smillert cmp_ok $!, '==', 22, ' $! is 22'; 91b39c5158Smillert } 92b39c5158Smillert 93b39c5158Smillert cmp_ok $!, '==', 22, " \$! has not been changed by $CompressClass destructor"; 94b39c5158Smillert 95b39c5158Smillert 96b39c5158Smillert { 97b39c5158Smillert my $uncomp; 98*256a93a4Safresh1 ok my $x = $UncompressClass->can('new')->( $UncompressClass, $name, -Append => 1) ; 99b39c5158Smillert 100b39c5158Smillert my $len ; 101b39c5158Smillert 1 while ($len = $x->read($result)) > 0 ; 102b39c5158Smillert 103b39c5158Smillert $! = 22 ; 104b39c5158Smillert 105b39c5158Smillert cmp_ok $!, '==', 22, ' $! is 22'; 106b39c5158Smillert } 107b39c5158Smillert 108b39c5158Smillert cmp_ok $!, '==', 22, " \$! has not been changed by $UncompressClass destructor"; 109b39c5158Smillert 110b39c5158Smillert is $result, "abc", " Got uncompressed content ok"; 111b39c5158Smillert 112b39c5158Smillert } 113b39c5158Smillert} 114b39c5158Smillert 115b39c5158Smillert1; 116