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
|
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;
BEGIN
{
plan skip_all => "Encode is not available"
if $] < 5.006 ;
eval { require Encode; Encode->import(); };
plan skip_all => "Encode is not available"
if $@ ;
# use Test::NoWarnings, if available
my $extra = 0 ;
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
plan tests => 29 + $extra ;
use_ok('Compress::Zlib', qw(:ALL zlib_version memGunzip memGzip));
}
# 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" ;
}
{
title "memGzip" ;
# length of this string is 2 characters
my $s = "\x{df}\x{100}";
my $cs = memGzip(Encode::encode_utf8($s));
# length stored at end of gzip file should be 4
my ($crc, $len) = unpack ("VV", substr($cs, -8, 8));
is $len, 4, " length is 4";
}
{
title "memGunzip when compressed gzip has been encoded" ;
my $s = "hello world" ;
my $co = memGzip($s);
is memGunzip(my $x = $co), $s, " match uncompressed";
utf8::upgrade($co);
my $un = memGunzip($co);
ok $un, " got uncompressed";
is $un, $s, " uncompressed matched original";
}
{
title "compress/uncompress";
my $s = "\x{df}\x{100}";
my $s_copy = $s ;
my $ces = compress(Encode::encode_utf8($s_copy));
ok $ces, " compressed ok" ;
my $un = Encode::decode_utf8(uncompress($ces));
is $un, $s, " decode_utf8 ok";
utf8::upgrade($ces);
$un = Encode::decode_utf8(uncompress($ces));
is $un, $s, " decode_utf8 ok";
}
{
title "gzopen" ;
my $s = "\x{df}\x{100}";
my $byte_len = length( Encode::encode_utf8($s) );
my ($uncomp) ;
my $lex = new LexFile my $name ;
ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ;
is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, " wrote $byte_len bytes" ;
ok ! $fil->gzclose, " gzclose ok" ;
ok $fil = gzopen($name, "rb"), " gzopen for read ok" ;
is $fil->gzread($uncomp), $byte_len, " read $byte_len bytes" ;
is length($uncomp), $byte_len, " uncompress is $byte_len bytes";
ok ! $fil->gzclose, "gzclose ok" ;
is $s, Encode::decode_utf8($uncomp), " decode_utf8 ok" ;
}
{
title "Catch wide characters";
my $a = "a\xFF\x{100}";
eval { memGzip($a) };
like($@, qr/Wide character in memGzip/, " wide characters in memGzip");
eval { memGunzip($a) };
like($@, qr/Wide character in memGunzip/, " wide characters in memGunzip");
eval { compress($a) };
like($@, qr/Wide character in compress/, " wide characters in compress");
eval { uncompress($a) };
like($@, qr/Wide character in uncompress/, " wide characters in uncompress");
my $lex = new LexFile my $name ;
ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ;
eval { $fil->gzwrite($a); } ;
like($@, qr/Wide character in gzwrite/, " wide characters in gzwrite");
ok ! $fil->gzclose, " gzclose ok" ;
}
|