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