4 @INC = ("../lib", "lib");
17 # use Test::NoWarnings, if available
20 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
22 plan tests => 595 + $extra ;
24 use_ok('Compress::Zlib', 2) ;
26 use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
27 use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
29 use_ok('Compress::Zlib::FileConstants');
36 my $string = shift || '' ;
40 ok my $def = new IO::Compress::Deflate \$buffer, %opts ;
41 is $def->write($string), length($string) ;
43 #print "ReadHeaderInfo\n"; hexDump(\$buffer);
45 ok my $inf = new IO::Uncompress::Inflate \$buffer ;
47 #ok $inf->read($uncomp) ;
50 while (($status = $inf->read($uncomp)) > 0) {
54 is $actual, length($string) ;
58 ok my $hdr = $inf->getHeaderInfo();
64 sub ReadHeaderInfoZlib
66 my $string = shift || '' ;
70 ok my $def = new Compress::Zlib::Deflate AppendOutput => 1, %opts ;
71 cmp_ok $def->deflate($string, $buffer), '==', Z_OK;
72 cmp_ok $def->flush($buffer), '==', Z_OK;
73 #print "ReadHeaderInfoZlib\n"; hexDump(\$buffer);
75 ok my $inf = new IO::Uncompress::Inflate \$buffer ;
77 #ok $inf->read($uncomp) ;
80 while (($status = $inf->read($uncomp)) > 0) {
84 is $actual, length($string) ;
88 ok my $hdr = $inf->getHeaderInfo();
97 my $inf = new IO::Uncompress::Inflate \$buffer ;
98 my $hdr = $inf->getHeaderInfo();
100 no warnings 'uninitialized' ;
101 while (my ($k, $v) = each %$hdr) {
102 print " $k -> $v\n" ;
107 # Check the Deflate Header Parameters
108 #========================================
110 my $lex = new LexFile my $name ;
113 title "Check default header settings" ;
119 my $hdr = ReadHeaderInfo($string);
121 is $hdr->{CM}, 8, " CM is 8";
122 is $hdr->{FDICT}, 0, " FDICT is 0";
127 title "Check user-defined header settings match zlib" ;
134 [ {-Level => 0}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
135 [ {-Level => 1}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
136 [ {-Level => 2}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
137 [ {-Level => 3}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
138 [ {-Level => 4}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
139 [ {-Level => 5}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
140 [ {-Level => 6}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
141 [ {-Level => 7}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
142 [ {-Level => 8}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
143 [ {-Level => 9}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
145 [ {-Level => Z_NO_COMPRESSION }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
146 [ {-Level => Z_BEST_SPEED }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
147 [ {-Level => Z_BEST_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
148 [ {-Level => Z_DEFAULT_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
150 [ {-Strategy => Z_HUFFMAN_ONLY}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
151 [ {-Strategy => Z_HUFFMAN_ONLY,
152 -Level => 3 }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
155 foreach my $test (@tests)
157 my $opts = $test->[0] ;
158 my $expect = $test->[1] ;
161 while (my ($k, $v) = each %$opts)
163 push @title, "$k => $v";
167 my $hdr = ReadHeaderInfo($string, %$opts);
169 my $hdr1 = ReadHeaderInfoZlib($string, %$opts);
171 is $hdr->{CM}, 8, " CM is 8";
172 is $hdr->{CINFO}, 7, " CINFO is 7";
173 is $hdr->{FDICT}, 0, " FDICT is 0";
175 while (my ($k, $v) = each %$expect)
177 if (ZLIB_VERNUM >= 0x1220)
178 { is $hdr->{$k}, $v, " $k is $v" }
180 { ok 1, " Skip test for $k" }
183 is $hdr->{CM}, $hdr1->{CM}, " CM matches";
184 is $hdr->{CINFO}, $hdr1->{CINFO}, " CINFO matches";
185 is $hdr->{FDICT}, $hdr1->{FDICT}, " FDICT matches";
186 is $hdr->{FLEVEL}, $hdr1->{FLEVEL}, " FLEVEL matches";
187 is $hdr->{FCHECK}, $hdr1->{FCHECK}, " FCHECK matches";
194 title "No compressed data at all";
196 my $hdr = ReadHeaderInfo("");
198 is $hdr->{CM}, 8, " CM is 8";
199 is $hdr->{FDICT}, 0, " FDICT is 0";
201 ok defined $hdr->{ADLER32}, " ADLER32 is defined" ;
202 is $hdr->{ADLER32}, 1, " ADLER32 is 1";
206 # Header Corruption Tests
213 ok my $x = new IO::Compress::Deflate \$good ;
214 ok $x->write($string) ;
218 title "Header Corruption - FCHECK failure - 1st byte wrong";
220 substr($buffer, 0, 1) = "\x00" ;
222 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
223 like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
228 title "Header Corruption - FCHECK failure - 2nd byte wrong";
230 substr($buffer, 1, 1) = "\x00" ;
232 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
233 like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
245 my $cmf = ($method & 0x0F) ;
246 $cmf |= (($cinfo & 0x0F) << 4) ;
247 my $flg = (($level & 0x03) << 6) ;
248 $flg |= (($fdict & 0x01) << 5) ;
249 my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
251 #print "check $fcheck\n";
253 return pack("CC", $cmf, $flg) ;
257 title "Header Corruption - CM not 8";
259 my $header = mkZlibHdr(3, 6, 0, 3);
261 substr($buffer, 0, 2) = $header;
263 my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
264 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
265 like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate \(CM is 3\)/',
272 # Trailer Corruption tests
279 ok my $x = new IO::Compress::Deflate \$good ;
280 ok $x->write($string) ;
283 foreach my $trim (-4 .. -1)
285 my $got = $trim + 4 ;
288 title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ;
290 my $expected_trailing = substr($good, -4, 4) ;
291 substr($expected_trailing, $trim) = '';
293 substr($buffer, $trim) = '';
294 writeFile($name, $buffer) ;
296 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => $s;
300 ok $gunz->read($uncomp) < 0 ;
301 like $IO::Uncompress::Inflate::InflateError,"/Trailer Error: trailer truncated. Expected 4 bytes, got $got/",
306 is $gunz->read($uncomp), length $string ;
309 ok $uncomp eq $string;
316 title "Trailer Corruption - CRC Wrong, strict" ;
318 my $crc = unpack("N", substr($buffer, -4, 4));
319 substr($buffer, -4, 4) = pack('N', $crc+1);
320 writeFile($name, $buffer) ;
322 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 1;
324 ok $gunz->read($uncomp) < 0 ;
325 like $IO::Uncompress::Inflate::InflateError,'/Trailer Error: CRC mismatch/',
326 "Trailer Error: CRC mismatch";
328 ok ! ${ $gunz->trailingData() } ;
329 ok $uncomp eq $string;
334 title "Trailer Corruption - CRC Wrong, no strict" ;
336 my $crc = unpack("N", substr($buffer, -4, 4));
337 substr($buffer, -4, 4) = pack('N', $crc+1);
338 writeFile($name, $buffer) ;
340 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 0;
342 ok $gunz->read($uncomp) >= 0 ;
344 ok ! ${ $gunz->trailingData() } ;
345 ok $uncomp eq $string;