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 $name = "test.gz" ;
111 my $lex = new LexFile $name ;
114 title "Check default header settings" ;
120 my $hdr = ReadHeaderInfo($string);
122 is $hdr->{CM}, 8, " CM is 8";
123 is $hdr->{FDICT}, 0, " FDICT is 0";
128 title "Check user-defined header settings match zlib" ;
135 [ {-Level => 0}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
136 [ {-Level => 1}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
137 [ {-Level => 2}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
138 [ {-Level => 3}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
139 [ {-Level => 4}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
140 [ {-Level => 5}, { FLEVEL => ZLIB_FLG_LEVEL_FAST } ],
141 [ {-Level => 6}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
142 [ {-Level => 7}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
143 [ {-Level => 8}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
144 [ {-Level => 9}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
146 [ {-Level => Z_NO_COMPRESSION }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
147 [ {-Level => Z_BEST_SPEED }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
148 [ {-Level => Z_BEST_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
149 [ {-Level => Z_DEFAULT_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
151 [ {-Strategy => Z_HUFFMAN_ONLY}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
152 [ {-Strategy => Z_HUFFMAN_ONLY,
153 -Level => 3 }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
156 foreach my $test (@tests)
158 my $opts = $test->[0] ;
159 my $expect = $test->[1] ;
162 while (my ($k, $v) = each %$opts)
164 push @title, "$k => $v";
168 my $hdr = ReadHeaderInfo($string, %$opts);
170 my $hdr1 = ReadHeaderInfoZlib($string, %$opts);
172 is $hdr->{CM}, 8, " CM is 8";
173 is $hdr->{CINFO}, 7, " CINFO is 7";
174 is $hdr->{FDICT}, 0, " FDICT is 0";
176 while (my ($k, $v) = each %$expect)
178 if (ZLIB_VERNUM >= 0x1220)
179 { is $hdr->{$k}, $v, " $k is $v" }
181 { ok 1, " Skip test for $k" }
184 is $hdr->{CM}, $hdr1->{CM}, " CM matches";
185 is $hdr->{CINFO}, $hdr1->{CINFO}, " CINFO matches";
186 is $hdr->{FDICT}, $hdr1->{FDICT}, " FDICT matches";
187 is $hdr->{FLEVEL}, $hdr1->{FLEVEL}, " FLEVEL matches";
188 is $hdr->{FCHECK}, $hdr1->{FCHECK}, " FCHECK matches";
195 title "No compressed data at all";
197 my $hdr = ReadHeaderInfo("");
199 is $hdr->{CM}, 8, " CM is 8";
200 is $hdr->{FDICT}, 0, " FDICT is 0";
202 ok defined $hdr->{ADLER32}, " ADLER32 is defined" ;
203 is $hdr->{ADLER32}, 1, " ADLER32 is 1";
207 # Header Corruption Tests
214 ok my $x = new IO::Compress::Deflate \$good ;
215 ok $x->write($string) ;
219 title "Header Corruption - FCHECK failure - 1st byte wrong";
221 substr($buffer, 0, 1) = "\x00" ;
223 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
224 like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
229 title "Header Corruption - FCHECK failure - 2nd byte wrong";
231 substr($buffer, 1, 1) = "\x00" ;
233 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
234 like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
246 my $cmf = ($method & 0x0F) ;
247 $cmf |= (($cinfo & 0x0F) << 4) ;
248 my $flg = (($level & 0x03) << 6) ;
249 $flg |= (($fdict & 0x01) << 5) ;
250 my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
252 #print "check $fcheck\n";
254 return pack("CC", $cmf, $flg) ;
258 title "Header Corruption - CM not 8";
260 my $header = mkZlibHdr(3, 6, 0, 3);
262 substr($buffer, 0, 2) = $header;
264 my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
265 ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0 ;
266 like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate \(CM is 3\)/',
273 # Trailer Corruption tests
280 ok my $x = new IO::Compress::Deflate \$good ;
281 ok $x->write($string) ;
284 foreach my $trim (-4 .. -1)
286 my $got = $trim + 4 ;
289 title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ;
291 my $expected_trailing = substr($good, -4, 4) ;
292 substr($expected_trailing, $trim) = '';
294 substr($buffer, $trim) = '';
295 writeFile($name, $buffer) ;
297 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => $s;
301 ok $gunz->read($uncomp) < 0 ;
302 like $IO::Uncompress::Inflate::InflateError,"/Trailer Error: trailer truncated. Expected 4 bytes, got $got/",
307 is $gunz->read($uncomp), length $string ;
310 ok $uncomp eq $string;
317 title "Trailer Corruption - CRC Wrong, strict" ;
319 my $crc = unpack("N", substr($buffer, -4, 4));
320 substr($buffer, -4, 4) = pack('N', $crc+1);
321 writeFile($name, $buffer) ;
323 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 1;
325 ok $gunz->read($uncomp) < 0 ;
326 like $IO::Uncompress::Inflate::InflateError,'/Trailer Error: CRC mismatch/',
327 "Trailer Error: CRC mismatch";
329 ok ! ${ $gunz->trailingData() } ;
330 ok $uncomp eq $string;
335 title "Trailer Corruption - CRC Wrong, no strict" ;
337 my $crc = unpack("N", substr($buffer, -4, 4));
338 substr($buffer, -4, 4) = pack('N', $crc+1);
339 writeFile($name, $buffer) ;
341 ok my $gunz = new IO::Uncompress::Inflate $name, Strict => 0;
343 ok $gunz->read($uncomp) >= 0 ;
345 ok ! ${ $gunz->trailingData() } ;
346 ok $uncomp eq $string;