4 @INC = ("../lib", "lib/compress");
8 use lib qw(t t/compress);
17 # use Test::NoWarnings, if available
20 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
23 plan tests => 910 + $extra ;
25 use_ok('Compress::Raw::Zlib') ;
26 use_ok('IO::Compress::Gzip::Constants') ;
28 use_ok('IO::Compress::Gzip', qw($GzipError)) ;
29 use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
35 # Check the Gzip Header Parameters
36 #========================================
38 my $ThisOS_code = $Compress::Raw::Zlib::gzip_os_code;
40 my $lex = new LexFile my $name ;
43 title "Check Defaults";
44 # Check Name defaults undef, no name, no comment
45 # and Time can be explicitly set.
47 my $hdr = readHeaderInfo($name, -Time => 1234);
49 is $hdr->{Time}, 1234;
50 ok ! defined $hdr->{Name};
51 is $hdr->{MethodName}, 'Deflated';
52 is $hdr->{ExtraFlags}, 0;
53 is $hdr->{MethodID}, Z_DEFLATED;
54 is $hdr->{OsID}, $ThisOS_code ;
55 ok ! defined $hdr->{Comment} ;
56 ok ! defined $hdr->{ExtraFieldRaw} ;
57 ok ! defined $hdr->{HeaderCRC} ;
58 ok ! $hdr->{isMinimalHeader} ;
63 title "Check name can be different from filename" ;
64 # Check Name can be different from filename
65 # Comment and Extra can be set
66 # Can specify a zero Time
68 my $comment = "This is a Comment" ;
69 my $extra = "A little something extra" ;
70 my $aname = "a new name" ;
71 my $hdr = readHeaderInfo $name,
75 -ExtraField => $extra,
79 ok $hdr->{Name} eq $aname;
80 ok $hdr->{MethodName} eq 'Deflated';
81 ok $hdr->{MethodID} == 8;
82 is $hdr->{ExtraFlags}, 0;
83 ok $hdr->{Comment} eq $comment ;
84 is $hdr->{OsID}, $ThisOS_code ;
85 ok ! $hdr->{isMinimalHeader} ;
86 ok ! defined $hdr->{HeaderCRC} ;
90 title "Check Time defaults to now" ;
92 # Check Time defaults to now
93 # and that can have empty name, comment and extrafield
95 my $hdr = readHeaderInfo $name,
102 ok $hdr->{Time} >= $before ;
103 ok $hdr->{Time} <= $after ;
105 ok defined $hdr->{Name} ;
106 ok $hdr->{Name} eq "";
107 ok defined $hdr->{Comment} ;
108 ok $hdr->{Comment} eq "";
109 ok defined $hdr->{ExtraFieldRaw} ;
110 ok $hdr->{ExtraFieldRaw} eq "";
111 is $hdr->{ExtraFlags}, 0;
113 ok ! $hdr->{isMinimalHeader} ;
114 ok $hdr->{TextFlag} ;
115 ok ! defined $hdr->{HeaderCRC} ;
116 is $hdr->{OsID}, $ThisOS_code ;
121 title "can have null extrafield" ;
124 my $hdr = readHeaderInfo $name,
128 -ExtraField => "\x00";
131 ok $hdr->{Time} >= $before ;
132 ok $hdr->{Time} <= $after ;
133 ok $hdr->{Name} eq "a";
134 ok $hdr->{Comment} eq "b";
135 is $hdr->{ExtraFlags}, 0;
136 ok $hdr->{ExtraFieldRaw} eq "\x00";
137 ok ! $hdr->{isMinimalHeader} ;
138 ok ! $hdr->{TextFlag} ;
139 ok ! defined $hdr->{HeaderCRC} ;
140 is $hdr->{OsID}, $ThisOS_code ;
145 title "can have undef name, comment, time and extrafield" ;
147 my $hdr = readHeaderInfo $name,
150 -ExtraField => undef,
153 ok $hdr->{Time} == 0;
154 ok ! defined $hdr->{Name} ;
155 ok ! defined $hdr->{Comment} ;
156 ok ! defined $hdr->{ExtraFieldRaw} ;
157 ok ! $hdr->{isMinimalHeader} ;
158 ok ! $hdr->{TextFlag} ;
159 ok ! defined $hdr->{HeaderCRC} ;
160 is $hdr->{OsID}, $ThisOS_code ;
164 for my $value ( "0D", "0A", "0A0D", "0D0A", "0A0A", "0D0D")
166 title "Comment with $value" ;
168 my $v = pack "h*", $value;
169 my $comment = "my${v}comment$v";
170 my $hdr = readHeaderInfo $name,
174 -Comment => $comment,
180 ok defined $hdr->{Name} ;
181 ok $hdr->{Name} eq "";
182 ok defined $hdr->{Comment} ;
183 is $hdr->{Comment}, $comment;
184 ok defined $hdr->{ExtraFieldRaw} ;
185 ok $hdr->{ExtraFieldRaw} eq "";
186 is $hdr->{ExtraFlags}, 0;
188 ok ! $hdr->{isMinimalHeader} ;
189 ok $hdr->{TextFlag} ;
190 ok ! defined $hdr->{HeaderCRC} ;
191 is $hdr->{OsID}, $ThisOS_code ;
196 title "Check crchdr" ;
198 my $hdr = readHeaderInfo $name, -HeaderCRC => 1;
200 ok ! defined $hdr->{Name};
201 is $hdr->{ExtraFlags}, 0;
202 ok ! defined $hdr->{ExtraFieldRaw} ;
203 ok ! defined $hdr->{Comment} ;
204 ok ! $hdr->{isMinimalHeader} ;
205 ok ! $hdr->{TextFlag} ;
206 ok defined $hdr->{HeaderCRC} ;
207 is $hdr->{OsID}, $ThisOS_code ;
211 title "Check ExtraFlags" ;
213 my $hdr = readHeaderInfo $name, -Level => Z_BEST_SPEED;
215 ok ! defined $hdr->{Name};
216 is $hdr->{ExtraFlags}, 2;
217 ok ! defined $hdr->{ExtraFieldRaw} ;
218 ok ! defined $hdr->{Comment} ;
219 ok ! $hdr->{isMinimalHeader} ;
220 ok ! $hdr->{TextFlag} ;
221 ok ! defined $hdr->{HeaderCRC} ;
223 $hdr = readHeaderInfo $name, -Level => Z_BEST_COMPRESSION;
225 ok ! defined $hdr->{Name};
226 is $hdr->{ExtraFlags}, 4;
227 ok ! defined $hdr->{ExtraFieldRaw} ;
228 ok ! defined $hdr->{Comment} ;
229 ok ! $hdr->{isMinimalHeader} ;
230 ok ! $hdr->{TextFlag} ;
231 ok ! defined $hdr->{HeaderCRC} ;
233 $hdr = readHeaderInfo $name, -Level => Z_BEST_COMPRESSION,
236 ok ! defined $hdr->{Name};
237 is $hdr->{ExtraFlags}, 42;
238 ok ! defined $hdr->{ExtraFieldRaw} ;
239 ok ! defined $hdr->{Comment} ;
240 ok ! $hdr->{isMinimalHeader} ;
241 ok ! $hdr->{TextFlag} ;
242 ok ! defined $hdr->{HeaderCRC} ;
250 for my $code ( -1, undef, '', 'fred' )
252 my $code_name = defined $code ? "'$code'" : "'undef'";
253 eval { new IO::Compress::Gzip $name, -OS_Code => $code } ;
254 like $@, mkErr("^IO::Compress::Gzip: Parameter 'OS_Code' must be an unsigned int, got $code_name"),
255 " Trap OS Code $code_name";
258 for my $code ( qw( 256 ) )
260 eval { ok ! new IO::Compress::Gzip($name, OS_Code => $code) };
261 like $@, mkErr("OS_Code must be between 0 and 255, got '$code'"),
262 " Trap OS Code $code";
263 like $GzipError, "/OS_Code must be between 0 and 255, got '$code'/",
264 " Trap OS Code $code";
267 for my $code ( qw(0 1 12 254 255) )
269 my $hdr = readHeaderInfo $name, OS_Code => $code;
271 is $hdr->{OsID}, $code, " Code is $code" ;
279 title 'Check ExtraField';
282 [1, ['AB' => ''] => [['AB'=>'']] ],
283 [1, {'AB' => ''} => [['AB'=>'']] ],
284 [1, ['AB' => 'Fred'] => [['AB'=>'Fred']] ],
285 [1, {'AB' => 'Fred'} => [['AB'=>'Fred']] ],
286 [1, ['Xx' => '','AB' => 'Fred'] => [['Xx' => ''],['AB'=>'Fred']] ],
287 [1, ['Xx' => '','Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred']] ],
290 'Xx' => 'Fred'] => [['Xx' => ''],['Xx'=>'Fred'],
293 ['AB' => 'Fred'] ] => [['Xx' => 'a'],['AB'=>'Fred']] ],
296 "\x01\x02" => "\x03"} => [['AB'=>'Fred'],
298 ["\x01\x02"=>"\x03"]] ],
299 [1, ['AB' => 'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE] =>
300 [['AB'=>'z' x GZIP_FEXTRA_SUBFIELD_MAX_SIZE]] ],
303 foreach my $test (@tests) {
304 my ($order, $input, $result) = @$test ;
305 ok my $x = new IO::Compress::Gzip $name,
306 -ExtraField => $input,
308 or diag "GzipError is $GzipError" ; ;
309 my $string = "abcd" ;
310 ok $x->write($string) ;
312 #is GZreadFile($name), $string ;
314 ok $x = new IO::Uncompress::Gunzip $name,
317 or diag "GunzipError is $GunzipError" ; ;
318 my $hdr = $x->getHeaderInfo();
320 ok ! defined $hdr->{Name};
321 ok ! defined $hdr->{Comment} ;
322 ok ! $hdr->{isMinimalHeader} ;
323 ok ! $hdr->{TextFlag} ;
324 ok defined $hdr->{HeaderCRC} ;
326 ok defined $hdr->{ExtraFieldRaw} ;
327 ok defined $hdr->{ExtraField} ;
329 my $extra = $hdr->{ExtraField} ;
332 eq_array $extra, $result;
334 eq_set $extra, $result;
341 title 'Write Invalid ExtraField';
343 my $prefix = 'Error with ExtraField Parameter: ';
345 [ sub{ "abc" } => "Not a scalar, array ref or hash ref"],
346 [ [ "a" ] => "Not even number of elements"],
347 [ [ "a" => "fred" ] => 'SubField ID not two chars long'],
348 [ [ "a\x00" => "fred" ] => 'SubField ID 2nd byte is 0x00'],
349 [ [ [ {}, "abc" ]] => "SubField ID is a reference"],
350 [ [ [ "ab", \1 ]] => "SubField Data is a reference"],
351 [ [ {"a" => "fred"} ] => "Not list of lists"],
352 [ [ ['ab'=>'x'],{"a" => "fred"} ] => "Not list of lists"],
353 [ [ ["aa"] ] => "SubField must have two parts"],
354 [ [ ["aa", "b", "c"] ] => "SubField must have two parts"],
355 [ [ ["ab" => 'x' x (GZIP_FEXTRA_SUBFIELD_MAX_SIZE + 1) ] ]
356 => "SubField Data too long"],
358 [ { 'abc', 1 } => "SubField ID not two chars long"],
359 [ { \1 , "abc" } => "SubField ID not two chars long"],
360 [ { "ab", \1 } => "SubField Data is a reference"],
365 foreach my $test (@tests) {
366 my ($input, $string) = @$test ;
369 eval { $x = new IO::Compress::Gzip \$buffer, -ExtraField => $input; };
370 like $@, mkErr("$prefix$string");
371 like $GzipError, "/$prefix$string/";
382 ["Sub-field truncated",
383 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
384 "Header Error: Truncated in FEXTRA Body Section",
385 ['a', undef, undef] ],
386 ["Length of field incorrect",
387 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
388 "Header Error: Truncated in FEXTRA Body Section",
389 ["ab", 255, "abc"] ],
390 ["Length of 2nd field incorrect",
391 "Error with ExtraField Parameter: Truncated in FEXTRA Body Section",
392 "Header Error: Truncated in FEXTRA Body Section",
393 ["ab", 3, "abc"], ["de", 7, "x"] ],
394 ["Length of 2nd field incorrect",
395 "Error with ExtraField Parameter: SubField ID 2nd byte is 0x00",
396 "Header Error: SubField ID 2nd byte is 0x00",
397 ["a\x00", 3, "abc"], ["de", 7, "x"] ],
400 foreach my $test (@tests)
402 my $name = shift @$test;
403 my $gzip_error = shift @$test;
404 my $gunzip_error = shift @$test;
406 title "Read Corrupt ExtraField - $name" ;
410 for my $field (@$test)
412 my ($id, $len, $data) = @$field;
414 $input .= $id if defined $id ;
415 $input .= pack("v", $len) if defined $len ;
416 $input .= $data if defined $data;
422 eval {$x = new IO::Compress::Gzip \$buffer, -ExtraField => $input, Strict => 1; };
423 like $@, mkErr("$gzip_error"), " $name";
424 like $GzipError, "/$gzip_error/", " $name";
426 ok ! $x, " IO::Compress::Gzip fails";
427 like $GzipError, "/$gzip_error/", " $name";
429 foreach my $check (0, 1)
431 ok $x = new IO::Compress::Gzip \$buffer,
432 ExtraField => $input,
434 or diag "GzipError is $GzipError" ;
435 my $string = "abcd" ;
438 is anyUncompress(\$buffer), $string ;
440 $x = new IO::Uncompress::Gunzip \$buffer,
443 ParseExtra => $check;
446 like $GunzipError, "/^$gunzip_error/";
458 title 'Check Minimal';
460 ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
461 my $string = "abcd" ;
462 ok $x->write($string) ;
464 #is GZreadFile($name), $string ;
466 ok $x = new IO::Uncompress::Gunzip $name ;
467 my $hdr = $x->getHeaderInfo();
469 ok $hdr->{Time} == 0;
470 is $hdr->{ExtraFlags}, 0;
471 ok ! defined $hdr->{Name} ;
472 ok ! defined $hdr->{ExtraFieldRaw} ;
473 ok ! defined $hdr->{Comment} ;
474 is $hdr->{OsName}, 'Unknown' ;
475 is $hdr->{MethodName}, "Deflated";
477 ok $hdr->{isMinimalHeader} ;
478 ok ! $hdr->{TextFlag} ;
483 # Check Minimal + no comressed data
484 # This is the smallest possible gzip file (20 bytes)
486 ok my $x = new IO::Compress::Gzip $name, -Minimal => 1;
488 #ok GZreadFile($name) eq '' ;
490 ok $x = new IO::Uncompress::Gunzip $name, -Append => 1 ;
494 $status = $x->read($data)
501 my $hdr = $x->getHeaderInfo();
504 ok defined $hdr->{ISIZE} ;
507 ok defined $hdr->{CRC32} ;
511 ok ! defined $hdr->{Name} ;
512 ok ! defined $hdr->{ExtraFieldRaw} ;
513 ok ! defined $hdr->{Comment} ;
514 is $hdr->{OsName}, 'Unknown' ;
515 is $hdr->{MethodName}, "Deflated";
517 ok $hdr->{isMinimalHeader} ;
518 ok ! $hdr->{TextFlag} ;
523 # Header Corruption Tests
530 ok my $x = new IO::Compress::Gzip \$good, -HeaderCRC => 1 ;
531 ok $x->write($string) ;
535 title "Header Corruption - Fingerprint wrong 1st byte" ;
537 substr($buffer, 0, 1) = 'x' ;
539 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
540 ok $GunzipError =~ /Header Error: Bad Magic/;
544 title "Header Corruption - Fingerprint wrong 2nd byte" ;
546 substr($buffer, 1, 1) = "\xFF" ;
548 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
549 ok $GunzipError =~ /Header Error: Bad Magic/;
550 #print "$GunzipError\n";
554 title "Header Corruption - CM not 8";
556 substr($buffer, 2, 1) = 'x' ;
558 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
559 like $GunzipError, '/Header Error: Not Deflate \(CM is \d+\)/';
563 title "Header Corruption - Use of Reserved Flags";
565 substr($buffer, 3, 1) = "\xff";
567 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0 ;
568 like $GunzipError, '/Header Error: Use of Reserved Bits in FLG field./';
572 title "Header Corruption - Fail HeaderCRC";
574 substr($buffer, 10, 1) = chr((ord(substr($buffer, 10, 1)) + 1) & 0xFF);
576 ok ! new IO::Uncompress::Gunzip \$buffer, -Transparent => 0, Strict => 1
577 or print "# $GunzipError\n";
578 like $GunzipError, '/Header Error: CRC16 mismatch/'
579 #or diag "buffer length " . length($buffer);
580 or hexDump(\$good), hexDump(\$buffer);
585 title "ExtraField max raw size";
587 my $store = "x" x GZIP_FEXTRA_MAX_SIZE ;
588 my $z = new IO::Compress::Gzip(\$x, ExtraField => $store, Strict => 0) ;
589 ok $z, "Created IO::Compress::Gzip object" ;
590 my $gunz = new IO::Uncompress::Gunzip \$x, Strict => 0;
591 ok $gunz, "Created IO::Uncompress::Gunzip object" ;
592 my $hdr = $gunz->getHeaderInfo();
595 is $hdr->{ExtraFieldRaw}, $store ;
599 title "Header Corruption - ExtraField too big";
601 eval { new IO::Compress::Gzip(\$x, -ExtraField => "x" x (GZIP_FEXTRA_MAX_SIZE + 1)) ;};
602 like $@, mkErr('Error with ExtraField Parameter: Too Large');
603 like $GzipError, '/Error with ExtraField Parameter: Too Large/';
607 title "Header Corruption - Create Name with Illegal Chars";
610 eval { new IO::Compress::Gzip \$x, -Name => "fred\x02" };
611 like $@, mkErr('Non ISO 8859-1 Character found in Name');
612 like $GzipError, '/Non ISO 8859-1 Character found in Name/';
614 ok my $gz = new IO::Compress::Gzip \$x,
616 -Name => "fred\x02" ;
619 ok ! new IO::Uncompress::Gunzip \$x,
623 like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Name/';
624 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
627 my $hdr = $gunzip->getHeaderInfo() ;
629 is $hdr->{Name}, "fred\x02";
634 title "Header Corruption - Null Chars in Name";
636 eval { new IO::Compress::Gzip \$x, -Name => "\x00" };
637 like $@, mkErr('Null Character found in Name');
638 like $GzipError, '/Null Character found in Name/';
640 eval { new IO::Compress::Gzip \$x, -Name => "abc\x00" };
641 like $@, mkErr('Null Character found in Name');
642 like $GzipError, '/Null Character found in Name/';
644 ok my $gz = new IO::Compress::Gzip \$x,
646 -Name => "abc\x00de" ;
648 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
651 my $hdr = $gunzip->getHeaderInfo() ;
653 is $hdr->{Name}, "abc";
658 title "Header Corruption - Create Comment with Illegal Chars";
661 eval { new IO::Compress::Gzip \$x, -Comment => "fred\x02" };
662 like $@, mkErr('Non ISO 8859-1 Character found in Comment');
663 like $GzipError, '/Non ISO 8859-1 Character found in Comment/';
665 ok my $gz = new IO::Compress::Gzip \$x,
667 -Comment => "fred\x02" ;
670 ok ! new IO::Uncompress::Gunzip \$x, Strict => 1,
673 like $GunzipError, '/Header Error: Non ISO 8859-1 Character found in Comment/';
674 ok my $gunzip = new IO::Uncompress::Gunzip \$x, Strict => 0;
676 my $hdr = $gunzip->getHeaderInfo() ;
678 is $hdr->{Comment}, "fred\x02";
683 title "Header Corruption - Null Char in Comment";
685 eval { new IO::Compress::Gzip \$x, -Comment => "\x00" };
686 like $@, mkErr('Null Character found in Comment');
687 like $GzipError, '/Null Character found in Comment/';
689 eval { new IO::Compress::Gzip \$x, -Comment => "abc\x00" } ;
690 like $@, mkErr('Null Character found in Comment');
691 like $GzipError, '/Null Character found in Comment/';
693 ok my $gz = new IO::Compress::Gzip \$x,
695 -Comment => "abc\x00de" ;
697 ok my $gunzip = new IO::Uncompress::Gunzip \$x,
700 my $hdr = $gunzip->getHeaderInfo() ;
702 is $hdr->{Comment}, "abc";
707 for my $index ( GZIP_MIN_HEADER_SIZE + 1 .. GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
709 title "Header Corruption - Truncated in Extra";
715 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1, Strict => 0,
716 -ExtraField => "hello" x 10 ;
717 ok $x->write($string) ;
720 substr($truncated, $index) = '' ;
721 #my $lex = new LexFile my $name ;
722 #writeFile($name, $truncated) ;
724 #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
725 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
729 like($GunzipError, '/^Header Error: Truncated in FEXTRA/');
736 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Name) -1)
738 title "Header Corruption - Truncated in Name";
744 ok my $x = new IO::Compress::Gzip \$truncated, -Name => $Name;
745 ok $x->write($string) ;
748 substr($truncated, $index) = '' ;
750 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
754 like $GunzipError, '/^Header Error: Truncated in FNAME Section/';
758 my $Comment = "comment" ;
759 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + length($Comment) -1)
761 title "Header Corruption - Truncated in Comment";
767 ok my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
768 ok $x->write($string) ;
771 substr($truncated, $index) = '' ;
772 #my $lex = new LexFile my $name ;
773 #writeFile($name, $truncated) ;
775 #my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
776 my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
780 like $GunzipError, '/^Header Error: Truncated in FCOMMENT Section/';
784 for my $index ( GZIP_MIN_HEADER_SIZE .. GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
786 title "Header Corruption - Truncated in CRC";
792 ok my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
793 ok $x->write($string) ;
796 substr($truncated, $index) = '' ;
797 my $lex = new LexFile my $name ;
798 writeFile($name, $truncated) ;
800 my $g = new IO::Uncompress::Gunzip $name, -Transparent => 0;
801 #my $g = new IO::Uncompress::Gunzip \$truncated, -Transparent => 0;
805 like $GunzipError, '/^Header Error: Truncated in FHCRC Section/';
811 # Trailer Corruption tests
819 ok my $x = new IO::Compress::Gzip \$good ;
820 ok $x->write($string) ;
824 writeFile($name, $good) ;
825 ok my $gunz = new IO::Uncompress::Gunzip $name,
828 1 while $gunz->read($uncomp) > 0 ;
830 ok $uncomp eq $string
831 or print "# got [$uncomp] wanted [$string]\n";;
833 foreach my $trim (-8 .. -1)
835 my $got = $trim + 8 ;
836 title "Trailer Corruption - Trailer truncated to $got bytes" ;
838 my $expected_trailing = substr($good, -8, 8) ;
839 substr($expected_trailing, $trim) = '';
841 substr($buffer, $trim) = '';
842 writeFile($name, $buffer) ;
844 foreach my $strict (0, 1)
846 ok my $gunz = new IO::Uncompress::Gunzip $name, -Strict => $strict ;
850 ok $gunz->read($uncomp) < 0 ;
851 like $GunzipError, "/Trailer Error: trailer truncated. Expected 8 bytes, got $got/";
855 ok $gunz->read($uncomp) > 0 ;
857 my $expected = substr($buffer, - $got);
858 is $gunz->trailingData(), $expected_trailing;
861 ok $uncomp eq $string;
868 title "Trailer Corruption - Length Wrong, CRC Correct" ;
870 my $actual_len = unpack("V", substr($buffer, -4, 4));
871 substr($buffer, -4, 4) = pack('V', $actual_len + 1);
872 writeFile($name, $buffer) ;
874 foreach my $strict (0, 1)
876 ok my $gunz = new IO::Uncompress::Gunzip $name,
881 ok $gunz->read($uncomp) < 0 ;
882 my $got_len = $actual_len + 1;
883 like $GunzipError, "/Trailer Error: ISIZE mismatch. Got $got_len, expected $actual_len/";
887 ok $gunz->read($uncomp) > 0 ;
889 #is $gunz->trailingData(), substr($buffer, - $got) ;
891 ok ! $gunz->trailingData() ;
893 ok $uncomp eq $string;
900 title "Trailer Corruption - Length Correct, CRC Wrong" ;
902 my $actual_crc = unpack("V", substr($buffer, -8, 4));
903 substr($buffer, -8, 4) = pack('V', $actual_crc+1);
904 writeFile($name, $buffer) ;
906 foreach my $strict (0, 1)
908 ok my $gunz = new IO::Uncompress::Gunzip $name,
913 ok $gunz->read($uncomp) < 0 ;
914 like $GunzipError, '/Trailer Error: CRC mismatch/';
918 ok $gunz->read($uncomp) > 0 ;
921 ok ! $gunz->trailingData() ;
923 ok $uncomp eq $string;
930 title "Trailer Corruption - Length Wrong, CRC Wrong" ;
932 my $actual_len = unpack("V", substr($buffer, -4, 4));
933 my $actual_crc = unpack("V", substr($buffer, -8, 4));
934 substr($buffer, -4, 4) = pack('V', $actual_len+1);
935 substr($buffer, -8, 4) = pack('V', $actual_crc+1);
936 writeFile($name, $buffer) ;
938 foreach my $strict (0, 1)
940 ok my $gunz = new IO::Uncompress::Gunzip $name,
945 ok $gunz->read($uncomp) < 0 ;
946 like $GunzipError, '/Trailer Error: CRC mismatch/';
950 ok $gunz->read($uncomp) > 0 ;
954 ok $uncomp eq $string;