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. 45is Compress::Zlib::zlib_version, ZLIB_VERSION, 46 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; 47 48{ 49 # gzsetparams 50 title "Testing gzsetparams"; 51 52 my $hello = "I am a HAL 9000 computer" x 2001 ; 53 my $len_hello = length $hello ; 54 my $goodbye = "Will I dream?" x 2010; 55 my $len_goodbye = length $goodbye; 56 57 my ($input, $err, $answer, $X, $status, $Answer); 58 59 my $lex = new LexFile my $name ; 60 ok my $x = gzopen($name, "wb"); 61 62 $input .= $hello; 63 is $x->gzwrite($hello), $len_hello, "gzwrite returned $len_hello" ; 64 65 # Error cases 66 eval { $x->gzsetparams() }; 67 like $@, mkErr('^Usage: Compress::Zlib::gzFile::gzsetparams\(file, level, strategy\)'); 68 69 # Change both Level & Strategy 70 $status = $x->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 71 cmp_ok $status, '==', Z_OK, "status is Z_OK"; 72 73 $input .= $goodbye; 74 is $x->gzwrite($goodbye), $len_goodbye, "gzwrite returned $len_goodbye" ; 75 76 ok ! $x->gzclose, "closed" ; 77 78 ok my $k = gzopen($name, "rb") ; 79 80 # calling gzsetparams on reading is not allowed. 81 $status = $k->gzsetparams(Z_BEST_SPEED, Z_HUFFMAN_ONLY) ; 82 cmp_ok $status, '==', Z_STREAM_ERROR, "status is Z_STREAM_ERROR" ; 83 84 my $len = length $input ; 85 my $uncompressed; 86 is $len, $k->gzread($uncompressed, $len) ; 87 88 ok $uncompressed eq $input ; 89 ok $k->gzeof ; 90 ok ! $k->gzclose ; 91 ok $k->gzeof ; 92} 93 94 95foreach my $CompressClass ('IO::Compress::Gzip', 96 'IO::Compress::Deflate', 97 'IO::Compress::RawDeflate', 98 ) 99{ 100 my $UncompressClass = getInverse($CompressClass); 101 102 title "Testing $CompressClass"; 103 104 105 # deflateParams 106 107 my $hello = "I am a HAL 9000 computer" x 2001 ; 108 my $len_hello = length $hello ; 109 my $goodbye = "Will I dream?" x 2010; 110 my $len_goodbye = length $goodbye; 111 112 #my ($input, $err, $answer, $X, $status, $Answer); 113 my $compressed; 114 115 ok my $x = new $CompressClass(\$compressed) ; 116 117 my $input .= $hello; 118 is $x->write($hello), $len_hello ; 119 120 # Change both Level & Strategy 121 ok $x->deflateParams(Z_BEST_SPEED, Z_HUFFMAN_ONLY); 122 123 $input .= $goodbye; 124 is $x->write($goodbye), $len_goodbye ; 125 126 ok $x->close ; 127 128 ok my $k = new $UncompressClass(\$compressed); 129 130 my $len = length $input ; 131 my $uncompressed; 132 is $k->read($uncompressed, $len), $len 133 or diag "$IO::Uncompress::Gunzip::GunzipError" ; 134 135 ok $uncompressed eq $input ; 136 ok $k->eof ; 137 ok $k->close ; 138 ok $k->eof ; 139} 140