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