Commit | Line | Data |
1a6a8453 |
1 | use lib 't'; |
2 | use strict; |
3 | use warnings; |
4 | use bytes; |
5 | |
6 | use Test::More ; |
25f0751f |
7 | use CompTestUtils; |
1a6a8453 |
8 | |
25f0751f |
9 | use Compress::Raw::Zlib 2 ; |
1a6a8453 |
10 | |
11 | BEGIN |
12 | { |
13 | plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib " |
25f0751f |
14 | . Compress::Raw::Zlib::zlib_version()) |
1a6a8453 |
15 | if ZLIB_VERNUM() < 0x1210 ; |
16 | |
17 | # use Test::NoWarnings, if available |
18 | my $extra = 0 ; |
19 | $extra = 1 |
20 | if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 }; |
21 | |
4e7676c7 |
22 | plan tests => 165 + $extra ; |
1a6a8453 |
23 | |
24 | } |
25 | |
26 | |
27 | sub run |
28 | { |
29 | |
30 | my $CompressClass = identify(); |
31 | my $UncompressClass = getInverse($CompressClass); |
32 | my $Error = getErrorRef($CompressClass); |
33 | my $UnError = getErrorRef($UncompressClass); |
34 | |
1a6a8453 |
35 | # Tests |
36 | # destination is a file that doesn't exist -- should work ok unless AnyDeflate |
37 | # destination isn't compressed at all |
38 | # destination is compressed but wrong format |
39 | # destination is corrupt - error messages should be correct |
40 | # use apend mode with old zlib - check that this is trapped |
41 | # destination is not seekable, readable, writable - test for filename & handle |
42 | |
43 | { |
44 | title "Misc error cases"; |
45 | |
25f0751f |
46 | eval { new Compress::Raw::Zlib::InflateScan Bufsize => 0} ; |
47 | like $@, mkErr("^Compress::Raw::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; |
1a6a8453 |
48 | |
25f0751f |
49 | eval { Compress::Raw::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ; |
50 | like $@, mkErr("^Compress::Raw::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0"; |
1a6a8453 |
51 | |
52 | } |
53 | |
54 | # output file/handle not writable |
55 | { |
56 | |
57 | foreach my $to_file (0,1) |
58 | { |
59 | if ($to_file) |
60 | { title "$CompressClass - Merge to filename that isn't writable" } |
61 | else |
62 | { title "$CompressClass - Merge to filehandle that isn't writable" } |
63 | |
64 | my $lex = new LexFile my $out_file ; |
65 | |
66 | # create empty file |
67 | open F, ">$out_file" ; print F "x"; close F; |
68 | ok -e $out_file, " file exists" ; |
69 | ok !-z $out_file, " and is not empty" ; |
70 | |
71 | # make unwritable |
72 | is chmod(0444, $out_file), 1, " chmod worked" ; |
73 | ok -e $out_file, " still exists after chmod" ; |
74 | |
75 | SKIP: |
76 | { |
77 | skip "Cannot create non-writable file", 3 |
78 | if -w $out_file ; |
79 | |
80 | ok ! -w $out_file, " chmod made file unwritable" ; |
81 | |
82 | my $dest ; |
83 | if ($to_file) |
84 | { $dest = $out_file } |
85 | else |
86 | { $dest = new IO::File "<$out_file" } |
87 | |
88 | my $gz = $CompressClass->new($dest, Merge => 1) ; |
89 | |
90 | ok ! $gz, " Did not create $CompressClass object"; |
91 | |
92 | { |
93 | if ($to_file) { |
94 | is $$Error, "Output file '$out_file' is not writable", |
95 | " Got non-writable filename message" ; |
96 | } |
97 | else { |
d53fb155 |
98 | ok $$Error, " Got error message" ; |
1a6a8453 |
99 | } |
100 | } |
101 | } |
102 | |
103 | chmod 0777, $out_file ; |
104 | } |
105 | } |
106 | |
107 | # output is not compressed at all |
108 | { |
109 | |
110 | my $lex = new LexFile my $out_file ; |
111 | |
112 | foreach my $to_file ( qw(buffer file handle ) ) |
113 | { |
114 | title "$CompressClass to $to_file, content is not compressed"; |
115 | |
116 | my $content = "abc" x 300 ; |
117 | my $buffer ; |
118 | my $disp_content = defined $content ? $content : '<undef>' ; |
119 | my $str_content = defined $content ? $content : '' ; |
120 | |
121 | if ($to_file eq 'buffer') |
122 | { |
123 | $buffer = \$content ; |
124 | } |
125 | else |
126 | { |
127 | writeFile($out_file, $content); |
128 | |
129 | if ($to_file eq 'handle') |
130 | { |
131 | $buffer = new IO::File "+<$out_file" |
132 | or die "# Cannot open $out_file: $!"; |
133 | } |
134 | else |
135 | { $buffer = $out_file } |
136 | } |
137 | |
138 | ok ! $CompressClass->new($buffer, Merge => 1), " constructor fails"; |
139 | { |
140 | like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', " got Bad Magic" ; |
141 | } |
142 | |
143 | } |
144 | } |
145 | |
146 | # output is empty |
147 | { |
148 | |
149 | my $lex = new LexFile my $out_file ; |
150 | |
151 | foreach my $to_file ( qw(buffer file handle ) ) |
152 | { |
153 | title "$CompressClass to $to_file, content is empty"; |
154 | |
155 | my $content = ''; |
156 | my $buffer ; |
157 | my $dest ; |
158 | |
159 | if ($to_file eq 'buffer') |
160 | { |
161 | $dest = $buffer = \$content ; |
162 | } |
163 | else |
164 | { |
165 | writeFile($out_file, $content); |
166 | $dest = $out_file; |
167 | |
168 | if ($to_file eq 'handle') |
169 | { |
170 | $buffer = new IO::File "+<$out_file" |
171 | or die "# Cannot open $out_file: $!"; |
172 | } |
173 | else |
174 | { $buffer = $out_file } |
175 | } |
176 | |
177 | ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), " constructor passes" |
178 | or diag $$Error; |
179 | |
180 | $gz->write("FGHI"); |
181 | $gz->close(); |
182 | |
183 | #hexDump($buffer); |
184 | my $out = anyUncompress($dest); |
185 | |
186 | is $out, "FGHI", ' Merge OK'; |
187 | } |
188 | } |
189 | |
190 | { |
191 | title "$CompressClass - Merge to file that doesn't exist"; |
192 | |
193 | my $lex = new LexFile my $out_file ; |
194 | |
195 | ok ! -e $out_file, " Destination file, '$out_file', does not exist"; |
196 | |
197 | ok my $gz1 = $CompressClass->new($out_file, Merge => 1) |
198 | or die "# $CompressClass->new failed: $$Error\n"; |
199 | #hexDump($buffer); |
200 | $gz1->write("FGHI"); |
201 | $gz1->close(); |
202 | |
203 | #hexDump($buffer); |
204 | my $out = anyUncompress($out_file); |
205 | |
206 | is $out, "FGHI", ' Merged OK'; |
207 | } |
208 | |
209 | { |
210 | |
211 | my $lex = new LexFile my $out_file ; |
212 | |
213 | foreach my $to_file ( qw( buffer file handle ) ) |
214 | { |
215 | foreach my $content (undef, '', 'x', 'abcde') |
216 | { |
217 | #next if ! defined $content && $to_file; |
218 | |
219 | my $buffer ; |
220 | my $disp_content = defined $content ? $content : '<undef>' ; |
221 | my $str_content = defined $content ? $content : '' ; |
222 | |
223 | if ($to_file eq 'buffer') |
224 | { |
225 | my $x ; |
226 | $buffer = \$x ; |
227 | title "$CompressClass to Buffer, content is '$disp_content'"; |
228 | } |
229 | else |
230 | { |
231 | $buffer = $out_file ; |
232 | if ($to_file eq 'handle') |
233 | { |
234 | title "$CompressClass to Filehandle, content is '$disp_content'"; |
235 | } |
236 | else |
237 | { |
238 | title "$CompressClass to File, content is '$disp_content'"; |
239 | } |
240 | } |
241 | |
242 | my $gz = $CompressClass->new($buffer); |
243 | my $len = defined $content ? length($content) : 0 ; |
244 | is $gz->write($content), $len, " write ok"; |
245 | ok $gz->close(), " close ok"; |
246 | |
247 | #hexDump($buffer); |
248 | is anyUncompress($buffer), $str_content, ' Destination is ok'; |
249 | |
250 | #if ($corruption) |
251 | #{ |
252 | # next if $TopTypes eq 'RawDeflate' && $content eq ''; |
253 | # |
254 | #} |
255 | |
256 | my $dest = $buffer ; |
257 | if ($to_file eq 'handle') |
258 | { |
259 | $dest = new IO::File "+<$buffer" ; |
260 | } |
261 | |
262 | my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1) |
263 | or die "## Error is $$Error\n"; |
264 | |
265 | #print "YYY\n"; |
266 | #hexDump($buffer); |
267 | #print "XXX\n"; |
268 | is $gz1->write("FGHI"), 4, " write returned 4"; |
269 | ok $gz1->close(), " close ok"; |
270 | |
271 | #hexDump($buffer); |
272 | my $out = anyUncompress($buffer); |
273 | |
274 | is $out, $str_content . "FGHI", ' Merged OK'; |
275 | #exit; |
276 | } |
277 | } |
278 | |
279 | } |
280 | |
281 | |
282 | |
283 | { |
284 | my $Func = getTopFuncRef($CompressClass); |
285 | my $TopType = getTopFuncName($CompressClass); |
286 | |
287 | my $buffer ; |
288 | |
289 | my $lex = new LexFile my $out_file ; |
290 | |
291 | foreach my $to_file (0, 1) |
292 | { |
293 | foreach my $content (undef, '', 'x', 'abcde') |
294 | { |
295 | my $disp_content = defined $content ? $content : '<undef>' ; |
296 | my $str_content = defined $content ? $content : '' ; |
297 | my $buffer ; |
298 | if ($to_file) |
299 | { |
300 | $buffer = $out_file ; |
301 | title "$TopType to File, content is '$disp_content'"; |
302 | } |
303 | else |
304 | { |
305 | my $x = ''; |
306 | $buffer = \$x ; |
307 | title "$TopType to Buffer, content is '$disp_content'"; |
308 | } |
309 | |
310 | |
311 | ok $Func->(\$content, $buffer), " Compress content"; |
312 | #hexDump($buffer); |
313 | is anyUncompress($buffer), $str_content, ' Destination is ok'; |
314 | |
315 | |
316 | ok $Func->(\"FGHI", $buffer, Merge => 1), " Merge content"; |
317 | |
318 | #hexDump($buffer); |
319 | my $out = anyUncompress($buffer); |
320 | |
321 | is $out, $str_content . "FGHI", ' Merged OK'; |
322 | } |
323 | } |
324 | |
325 | } |
326 | |
327 | } |
328 | |
329 | |
330 | 1; |