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