Commit | Line | Data |
---|---|---|
16816334 | 1 | BEGIN { |
d695c1a1 | 2 | if ($ENV{PERL_CORE}) { |
16816334 | 3 | chdir 't' if -d 't'; |
1a6a8453 | 4 | @INC = ("../lib", "lib/compress"); |
16816334 RGS |
5 | } |
6 | } | |
642e522c | 7 | |
25f0751f | 8 | use lib qw(t t/compress); |
642e522c RGS |
9 | use strict; |
10 | use warnings; | |
11 | use bytes; | |
12 | ||
13 | use Test::More ; | |
25f0751f | 14 | use CompTestUtils; |
642e522c RGS |
15 | |
16 | BEGIN | |
17 | { | |
18 | plan skip_all => "Encode is not available" | |
19 | if $] < 5.006 ; | |
20 | ||
21 | eval { require Encode; Encode->import(); }; | |
22 | ||
23 | plan skip_all => "Encode is not available" | |
24 | if $@ ; | |
25 | ||
26 | # use Test::NoWarnings, if available | |
27 | my $extra = 0 ; | |
28 | $extra = 1 | |
29 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; | |
30 | ||
93d092e2 | 31 | plan tests => 29 + $extra ; |
642e522c | 32 | |
9b5fd1d4 | 33 | use_ok('Compress::Zlib', qw(:ALL zlib_version memGunzip memGzip)); |
642e522c RGS |
34 | } |
35 | ||
36 | ||
37 | ||
38 | ||
39 | # Check zlib_version and ZLIB_VERSION are the same. | |
e8796d61 CBW |
40 | SKIP: { |
41 | skip "TEST_SKIP_VERSION_CHECK is set", 1 | |
42 | if $ENV{TEST_SKIP_VERSION_CHECK}; | |
43 | is Compress::Zlib::zlib_version, ZLIB_VERSION, | |
44 | "ZLIB_VERSION matches Compress::Zlib::zlib_version" ; | |
45 | } | |
642e522c | 46 | |
642e522c | 47 | { |
93d092e2 | 48 | title "memGzip" ; |
642e522c RGS |
49 | # length of this string is 2 characters |
50 | my $s = "\x{df}\x{100}"; | |
51 | ||
9b5fd1d4 | 52 | my $cs = memGzip(Encode::encode_utf8($s)); |
642e522c RGS |
53 | |
54 | # length stored at end of gzip file should be 4 | |
55 | my ($crc, $len) = unpack ("VV", substr($cs, -8, 8)); | |
56 | ||
93d092e2 | 57 | is $len, 4, " length is 4"; |
642e522c RGS |
58 | } |
59 | ||
60 | { | |
93d092e2 PM |
61 | title "memGunzip when compressed gzip has been encoded" ; |
62 | my $s = "hello world" ; | |
642e522c | 63 | |
9b5fd1d4 PM |
64 | my $co = memGzip($s); |
65 | is memGunzip(my $x = $co), $s, " match uncompressed"; | |
642e522c | 66 | |
93d092e2 PM |
67 | utf8::upgrade($co); |
68 | ||
9b5fd1d4 | 69 | my $un = memGunzip($co); |
93d092e2 PM |
70 | ok $un, " got uncompressed"; |
71 | ||
72 | is $un, $s, " uncompressed matched original"; | |
642e522c RGS |
73 | } |
74 | ||
75 | { | |
76 | title "compress/uncompress"; | |
77 | ||
78 | my $s = "\x{df}\x{100}"; | |
79 | my $s_copy = $s ; | |
80 | ||
642e522c RGS |
81 | my $ces = compress(Encode::encode_utf8($s_copy)); |
82 | ||
83 | ok $ces, " compressed ok" ; | |
84 | ||
642e522c | 85 | my $un = Encode::decode_utf8(uncompress($ces)); |
642e522c RGS |
86 | is $un, $s, " decode_utf8 ok"; |
87 | ||
93d092e2 PM |
88 | utf8::upgrade($ces); |
89 | $un = Encode::decode_utf8(uncompress($ces)); | |
90 | is $un, $s, " decode_utf8 ok"; | |
91 | ||
642e522c RGS |
92 | } |
93 | ||
94 | { | |
95 | title "gzopen" ; | |
96 | ||
642e522c RGS |
97 | my $s = "\x{df}\x{100}"; |
98 | my $byte_len = length( Encode::encode_utf8($s) ); | |
99 | my ($uncomp) ; | |
100 | ||
9f2e3514 | 101 | my $lex = new LexFile my $name ; |
642e522c RGS |
102 | ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; |
103 | ||
104 | is $fil->gzwrite(Encode::encode_utf8($s)), $byte_len, " wrote $byte_len bytes" ; | |
105 | ||
106 | ok ! $fil->gzclose, " gzclose ok" ; | |
107 | ||
108 | ok $fil = gzopen($name, "rb"), " gzopen for read ok" ; | |
109 | ||
110 | is $fil->gzread($uncomp), $byte_len, " read $byte_len bytes" ; | |
111 | is length($uncomp), $byte_len, " uncompress is $byte_len bytes"; | |
112 | ||
113 | ok ! $fil->gzclose, "gzclose ok" ; | |
114 | ||
642e522c | 115 | is $s, Encode::decode_utf8($uncomp), " decode_utf8 ok" ; |
642e522c RGS |
116 | } |
117 | ||
93d092e2 PM |
118 | { |
119 | title "Catch wide characters"; | |
120 | ||
121 | my $a = "a\xFF\x{100}"; | |
9b5fd1d4 | 122 | eval { memGzip($a) }; |
93d092e2 PM |
123 | like($@, qr/Wide character in memGzip/, " wide characters in memGzip"); |
124 | ||
9b5fd1d4 | 125 | eval { memGunzip($a) }; |
93d092e2 PM |
126 | like($@, qr/Wide character in memGunzip/, " wide characters in memGunzip"); |
127 | ||
9b5fd1d4 | 128 | eval { compress($a) }; |
93d092e2 PM |
129 | like($@, qr/Wide character in compress/, " wide characters in compress"); |
130 | ||
9b5fd1d4 | 131 | eval { uncompress($a) }; |
93d092e2 PM |
132 | like($@, qr/Wide character in uncompress/, " wide characters in uncompress"); |
133 | ||
134 | my $lex = new LexFile my $name ; | |
135 | ok my $fil = gzopen($name, "wb"), " gzopen for write ok" ; | |
136 | ||
137 | eval { $fil->gzwrite($a); } ; | |
138 | like($@, qr/Wide character in gzwrite/, " wide characters in gzwrite"); | |
139 | ||
140 | ok ! $fil->gzclose, " gzclose ok" ; | |
141 | } | |
642e522c | 142 |