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 |
5 | } |
6 | } |
642e522c |
7 | |
8 | use lib 't'; |
9 | use strict; |
10 | use warnings; |
11 | use bytes; |
12 | |
1a6a8453 |
13 | # TODO -- split out & add zip/bzip2 |
14 | |
642e522c |
15 | use Test::More ; |
16 | use ZlibTestUtils; |
17 | |
18 | BEGIN { |
19 | # use Test::NoWarnings, if available |
20 | my $extra = 0 ; |
21 | $extra = 1 |
22 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
23 | |
24 | plan tests => 2374 + $extra; |
25 | |
26 | use_ok('Compress::Zlib', 2) ; |
27 | |
28 | use_ok('IO::Compress::Gzip', qw($GzipError)) ; |
29 | use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ; |
30 | |
31 | use_ok('IO::Compress::Deflate', qw($DeflateError)) ; |
32 | use_ok('IO::Uncompress::Inflate', qw($InflateError)) ; |
33 | |
34 | use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ; |
35 | use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ; |
36 | |
37 | } |
38 | |
39 | |
40 | my $hello = <<EOM ; |
41 | hello world |
42 | this is a test |
43 | some more stuff on this line |
44 | ad finally... |
45 | EOM |
46 | |
47 | my $blocksize = 10 ; |
48 | |
49 | |
50 | foreach my $CompressClass ('IO::Compress::Gzip', 'IO::Compress::Deflate') |
51 | { |
52 | my $UncompressClass = getInverse($CompressClass); |
53 | |
54 | |
55 | my $compressed ; |
56 | my $cc ; |
57 | my $gz ; |
58 | if ($CompressClass eq 'IO::Compress::Gzip') { |
59 | ok( my $x = new IO::Compress::Gzip \$compressed, |
60 | -Name => "My name", |
61 | -Comment => "a comment", |
62 | -ExtraField => ['ab' => "extra"], |
63 | -HeaderCRC => 1); |
64 | ok $x->write($hello) ; |
65 | ok $x->close ; |
66 | $cc = $compressed ; |
67 | |
68 | ok($gz = new IO::Uncompress::Gunzip \$cc, |
69 | -Transparent => 0) |
70 | or diag "$GunzipError"; |
71 | my $un; |
72 | ok $gz->read($un) > 0 ; |
73 | ok $gz->close(); |
74 | ok $un eq $hello ; |
75 | } |
76 | else { |
77 | ok( my $x = new $CompressClass(\$compressed)); |
78 | ok $x->write($hello) ; |
79 | ok $x->close ; |
80 | $cc = $compressed ; |
81 | |
82 | ok($gz = new $UncompressClass(\$cc, |
83 | -Transparent => 0)) |
84 | or diag "$GunzipError"; |
85 | my $un; |
86 | ok $gz->read($un) > 0 ; |
87 | ok $gz->close(); |
88 | ok $un eq $hello ; |
89 | } |
90 | |
91 | |
92 | for my $trans ( 0 .. 1) |
93 | { |
94 | title "Testing $CompressClass, Transparent $trans"; |
95 | |
96 | my $info = $gz->getHeaderInfo() ; |
97 | my $header_size = $info->{HeaderLength}; |
98 | my $trailer_size = $info->{TrailerLength}; |
99 | ok 1, "Compressed size is " . length($compressed) ; |
100 | ok 1, "Header size is $header_size" ; |
101 | ok 1, "Trailer size is $trailer_size" ; |
102 | |
103 | title "Fingerprint Truncation"; |
104 | foreach my $i (1) |
105 | { |
9f2e3514 |
106 | my $lex = new LexFile my $name ; |
642e522c |
107 | |
108 | ok 1, "Length $i" ; |
109 | my $part = substr($compressed, 0, $i); |
110 | writeFile($name, $part); |
111 | |
112 | my $gz = new $UncompressClass $name, |
113 | -BlockSize => $blocksize, |
114 | -Transparent => $trans; |
115 | if ($trans) { |
116 | ok $gz; |
117 | ok ! $gz->error() ; |
118 | my $buff ; |
119 | ok $gz->read($buff) == length($part) ; |
120 | ok $buff eq $part ; |
121 | ok $gz->eof() ; |
122 | $gz->close(); |
123 | } |
124 | else { |
125 | ok !$gz; |
126 | } |
127 | |
128 | } |
129 | |
130 | title "Header Truncation"; |
131 | # |
132 | # Any header corruption past the fingerprint is considered catastrophic |
133 | # so even if Transparent is set, it should still fail |
134 | # |
135 | foreach my $i (2 .. $header_size -1) |
136 | { |
9f2e3514 |
137 | my $lex = new LexFile my $name ; |
642e522c |
138 | |
139 | ok 1, "Length $i" ; |
140 | my $part = substr($compressed, 0, $i); |
141 | writeFile($name, $part); |
142 | ok ! defined new $UncompressClass $name, |
143 | -BlockSize => $blocksize, |
144 | -Transparent => $trans; |
145 | #ok $gz->eof() ; |
146 | } |
147 | |
148 | title "Compressed Data Truncation"; |
149 | foreach my $i ($header_size .. length($compressed) - 1 - $trailer_size) |
150 | { |
151 | |
9f2e3514 |
152 | my $lex = new LexFile my $name ; |
642e522c |
153 | |
154 | ok 1, "Length $i" ; |
155 | my $part = substr($compressed, 0, $i); |
156 | writeFile($name, $part); |
157 | ok my $gz = new $UncompressClass $name, |
158 | -BlockSize => $blocksize, |
159 | -Transparent => $trans; |
160 | my $un ; |
161 | my $status = 0 ; |
162 | $status = $gz->read($un) while $status >= 0 ; |
163 | ok $status < 0 ; |
164 | ok $gz->eof() ; |
165 | ok $gz->error() ; |
166 | $gz->close(); |
167 | } |
168 | |
169 | # RawDeflate does not have a trailer |
170 | next if $CompressClass eq 'IO::Compress::RawDeflate' ; |
171 | |
172 | title "Compressed Trailer Truncation"; |
173 | foreach my $i (length($compressed) - $trailer_size .. length($compressed) -1 ) |
174 | { |
175 | foreach my $lax (0, 1) |
176 | { |
9f2e3514 |
177 | my $lex = new LexFile my $name ; |
642e522c |
178 | |
179 | ok 1, "Length $i, Lax $lax" ; |
180 | my $part = substr($compressed, 0, $i); |
181 | writeFile($name, $part); |
182 | ok my $gz = new $UncompressClass $name, |
183 | -BlockSize => $blocksize, |
184 | -Strict => !$lax, |
185 | -Append => 1, |
186 | -Transparent => $trans; |
187 | my $un = ''; |
188 | my $status = 1 ; |
189 | $status = $gz->read($un) while $status > 0 ; |
190 | |
191 | if ($lax) |
192 | { |
193 | is $un, $hello; |
194 | is $status, 0 |
195 | or diag "Status $status Error is " . $gz->error() ; |
196 | ok $gz->eof() |
197 | or diag "Status $status Error is " . $gz->error() ; |
198 | ok ! $gz->error() ; |
199 | } |
200 | else |
201 | { |
202 | ok $status < 0 |
203 | or diag "Status $status Error is " . $gz->error() ; |
204 | ok $gz->eof() |
205 | or diag "Status $status Error is " . $gz->error() ; |
206 | ok $gz->error() ; |
207 | } |
208 | |
209 | $gz->close(); |
210 | } |
211 | } |
212 | } |
213 | } |
214 | |
215 | |
216 | foreach my $CompressClass ( 'IO::Compress::RawDeflate') |
217 | { |
218 | my $UncompressClass = getInverse($CompressClass); |
219 | my $Error = getErrorRef($UncompressClass); |
220 | |
221 | my $compressed ; |
222 | ok( my $x = new IO::Compress::RawDeflate \$compressed); |
223 | ok $x->write($hello) ; |
224 | ok $x->close ; |
225 | |
226 | |
227 | my $cc = $compressed ; |
228 | |
229 | my $gz ; |
230 | ok($gz = new $UncompressClass(\$cc, |
231 | -Transparent => 0)) |
232 | or diag "$$Error\n"; |
233 | my $un; |
234 | ok $gz->read($un) > 0 ; |
235 | ok $gz->close(); |
236 | ok $un eq $hello ; |
237 | |
238 | for my $trans (0 .. 1) |
239 | { |
240 | title "Testing $CompressClass, Transparent = $trans"; |
241 | |
242 | my $info = $gz->getHeaderInfo() ; |
243 | my $header_size = $info->{HeaderLength}; |
244 | my $trailer_size = $info->{TrailerLength}; |
245 | ok 1, "Compressed size is " . length($compressed) ; |
246 | ok 1, "Header size is $header_size" ; |
247 | ok 1, "Trailer size is $trailer_size" ; |
248 | |
249 | |
250 | title "Compressed Data Truncation"; |
251 | foreach my $i (0 .. $blocksize) |
252 | { |
253 | |
9f2e3514 |
254 | my $lex = new LexFile my $name ; |
642e522c |
255 | |
256 | ok 1, "Length $i" ; |
257 | my $part = substr($compressed, 0, $i); |
258 | writeFile($name, $part); |
259 | my $gz = new $UncompressClass $name, |
260 | -BlockSize => $blocksize, |
261 | -Transparent => $trans; |
262 | if ($trans) { |
263 | ok $gz; |
264 | ok ! $gz->error() ; |
265 | my $buff = ''; |
1a6a8453 |
266 | is $gz->read($buff), length $part ; |
267 | is $buff, $part ; |
642e522c |
268 | ok $gz->eof() ; |
269 | $gz->close(); |
270 | } |
271 | else { |
272 | ok !$gz; |
273 | } |
274 | } |
275 | |
276 | foreach my $i ($blocksize+1 .. length($compressed)-1) |
277 | { |
278 | |
9f2e3514 |
279 | my $lex = new LexFile my $name ; |
642e522c |
280 | |
281 | ok 1, "Length $i" ; |
282 | my $part = substr($compressed, 0, $i); |
283 | writeFile($name, $part); |
284 | ok my $gz = new $UncompressClass $name, |
285 | -BlockSize => $blocksize, |
286 | -Transparent => $trans; |
287 | my $un ; |
288 | my $status = 0 ; |
289 | $status = $gz->read($un) while $status >= 0 ; |
290 | ok $status < 0 ; |
291 | ok $gz->eof() ; |
292 | ok $gz->error() ; |
293 | $gz->close(); |
294 | } |
295 | } |
296 | |
297 | } |
298 | |