1BEGIN { 2 if ($ENV{PERL_CORE}) { 3 chdir 't' if -d 't'; 4 @INC = ("../lib", "lib/compress"); 5 } 6} 7 8use lib qw(t t/compress); 9use strict; 10use warnings; 11use bytes; 12 13use Test::More ; 14use CompTestUtils; 15 16use Compress::Zlib 2 ; 17 18use IO::Compress::Gzip ; 19use IO::Uncompress::Gunzip ; 20 21use IO::Compress::Deflate ; 22use IO::Uncompress::Inflate ; 23 24use IO::Compress::RawDeflate ; 25use IO::Uncompress::RawInflate ; 26 27our ($extra); 28 29 30BEGIN 31{ 32 # use Test::NoWarnings, if available 33 $extra = 0 ; 34 $extra = 1 35 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; 36} 37 38my $ver = Compress::Zlib::zlib_version(); 39plan skip_all => "gzsetparams needs zlib 1.0.6 or better. You have $ver\n" 40 if ZLIB_VERNUM() < 0x1060 ; 41 42plan tests => 51 + $extra ; 43 44# Check zlib_version and ZLIB_VERSION are the same. 45SKIP: { 46 skip "TEST_SKIP_VERSION_CHECK is set", 1 47 if $ENV{TEST_SKIP_VERSION_CHECK}; 48 is Compress::Zlib::zlib_version, ZLIB_VERSION, 49 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; 50} 51 52{ 53 # gzsetparams 54 title "Testing gzsetparams"; 55 56 my $hello = "I am a HAL 9000 computer" x 2001 ; 57 my $len_hello = length $hello ; 58 my $goodbye = "Will I dream?" x 2010; 59 my $len_goodbye = length $goodbye; 60 61 my ($input, $err, $answer, $X, $status, $Answer); 62 63 my $lex = new LexFile my $name ; 64 ok my $x = gzopen($name, "wb"); 65 66 $input .= $hello; 67 is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ; 68 69 # Error cases 70 eval { $x->gzsetparams() }; 71 like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)'); 72 73 # Change both Level & Strategy 74 $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 75 cmp_ok $status, '==', Z_OK, "status is Z_OK"; 76 77 $input .= $goodbye; 78 is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ; 79 80 ok ! $x->gzclose, "closed" ; 81 82 ok my $k = gzopen($name, "rb") ; 83 84 # calling gzsetparams on reading is not allowed. 85 $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 86 cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ; 87 88 my $len = length $input ; 89 my $uncompressed; 90 is $len, $k->gzread($uncompressed, $len) ; 91 92 ok $uncompressed eq $input ; 93 ok $k->gzeof ; 94 ok ! $k->gzclose ; 95 ok $k->gzeof ; 96} 97 98 99foreach my $CompressClass ('IO::Compress::Gzip', 100 'IO::Compress::Deflate', 101 'IO::Compress::RawDeflate', 102 ) 103{ 104 my $UncompressClass = getInverse($CompressClass); 105 106 title "Testing $CompressClass"; 107 108 109 # deflateParams 110 111 my $hello = "I am a HAL 9000 computer" x 2001 ; 112 my $len_hello = length $hello ; 113 my $goodbye = "Will I dream?" x 2010; 114 my $len_goodbye = length $goodbye; 115 116 #my ($input, $err, $answer, $X, $status, $Answer); 117 my $compressed; 118 119 ok my $x = new $CompressClass(\$compressed) ; 120 121 my $input .= $hello; 122 is $x->write($hello), $len_hello, "wrote $len_hello bytes" ; 123 124 # Change both Level & Strategy 125 ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY), "deflateParams ok"; 126 127 $input .= $goodbye; 128 is $x->write($goodbye), $len_goodbye, "wrote $len_goodbye bytes" ; 129 130 ok $x->close, "closed $CompressClass object" ; 131 132 my $k = new $UncompressClass(\$compressed); 133 isa_ok $k, $UncompressClass; 134 135 my $len = length $input ; 136 my $uncompressed; 137 is $k->read($uncompressed, $len), $len 138 or diag "$IO::Uncompress::Gunzip::GunzipError" ; 139 140 ok $uncompressed eq $input, "got expected uncompressed data" 141 or diag("unc len = " . length($uncompressed) . ", input len = " . 142 length($input) . "\n") ; 143 ok $k->eof, "eof" ; 144 ok $k->close, "closed" ; 145 ok $k->eof, "eof" ; 146} 147