11 use Compress::Zlib 2 ;
13 use IO::Compress::Gzip qw($GzipError);
14 use IO::Uncompress::Gunzip qw($GunzipError);
16 use IO::Compress::Deflate qw($DeflateError);
17 use IO::Uncompress::Inflate qw($InflateError);
19 use IO::Compress::RawDeflate qw($RawDeflateError);
20 use IO::Uncompress::RawInflate qw($RawInflateError);
25 plan(skip_all => "Merge needs Zlib 1.2.1 or better - you have Zlib "
26 . Compress::Zlib::zlib_version())
27 if ZLIB_VERNUM() < 0x1210 ;
29 # use Test::NoWarnings, if available
32 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
34 plan tests => 490 + $extra ;
39 # Check zlib_version and ZLIB_VERSION are the same.
40 is Compress::Zlib::zlib_version, ZLIB_VERSION,
41 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
44 # destination is a file that doesn't exist -- should work ok unless AnyDeflate
45 # destination isn't compressed at all
46 # destination is compressed but wrong format
47 # destination is corrupt - error messages should be correct
48 # use apend mode with old zlib - check that this is trapped
49 # destination is not seekable, readable, writable - test for filename & handle
52 title "Misc error cases";
54 eval { new Compress::Zlib::InflateScan Bufsize => 0} ;
55 like $@, mkErr("^Compress::Zlib::InflateScan::new: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0";
57 eval { Compress::Zlib::inflateScanStream::createDeflateStream(undef, Bufsize => 0) } ;
58 like $@, mkErr("^Compress::Zlib::InflateScan::createDeflateStream: Bufsize must be >= 1, you specified 0"), " catch bufsize == 0";
62 # output file/handle not writable
63 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
66 my $Error = getErrorRef($CompressClass);
68 foreach my $to_file (0,1)
71 { title "$CompressClass - Merge to filename that isn't writable" }
73 { title "$CompressClass - Merge to filehandle that isn't writable" }
75 my $out_file = 'abcde.out';
76 my $lex = new LexFile($out_file) ;
79 open F, ">$out_file" ; print F "x"; close F;
80 ok -e $out_file, " file exists" ;
81 ok !-z $out_file, " and is not empty" ;
84 is chmod(0444, $out_file), 1, " chmod worked" ;
85 ok -e $out_file, " still exists after chmod" ;
89 skip "Cannot create non-writable file", 3
92 ok ! -w $out_file, " chmod made file unwritable" ;
98 { $dest = new IO::File "<$out_file" }
100 my $gz = $CompressClass->new($dest, Merge => 1) ;
102 ok ! $gz, " Did not create $CompressClass object";
106 is $$Error, "Output file '$out_file' is not writable",
107 " Got non-writable filename message" ;
110 is $$Error, "Output filehandle is not writable",
111 " Got non-writable filehandle message" ;
116 chmod 0777, $out_file ;
120 # output is not compressed at all
121 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
124 my $Error = getErrorRef($CompressClass);
126 my $out_file = 'abcde.out';
127 my $lex = new LexFile($out_file) ;
129 foreach my $to_file ( qw(buffer file handle ) )
131 title "$CompressClass to $to_file, content is not compressed";
133 my $content = "abc" x 300 ;
135 my $disp_content = defined $content ? $content : '<undef>' ;
136 my $str_content = defined $content ? $content : '' ;
138 if ($to_file eq 'buffer')
140 $buffer = \$content ;
144 writeFile($out_file, $content);
146 if ($to_file eq 'handle')
148 $buffer = new IO::File "+<$out_file"
149 or die "# Cannot open $out_file: $!";
152 { $buffer = $out_file }
155 ok ! $CompressClass->new($buffer, Merge => 1), " constructor fails";
157 like $$Error, '/Cannot create InflateScan object: (Header Error|unexpected end of file)/', " got Bad Magic" ;
164 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
167 my $Error = getErrorRef($CompressClass);
169 my $out_file = 'abcde.out';
170 my $lex = new LexFile($out_file) ;
172 foreach my $to_file ( qw(buffer file handle ) )
174 title "$CompressClass to $to_file, content is empty";
180 if ($to_file eq 'buffer')
182 $dest = $buffer = \$content ;
186 writeFile($out_file, $content);
189 if ($to_file eq 'handle')
191 $buffer = new IO::File "+<$out_file"
192 or die "# Cannot open $out_file: $!";
195 { $buffer = $out_file }
198 ok my $gz = $CompressClass->new($buffer, Merge => 1, AutoClose => 1), " constructor passes";
204 my $out = anyUncompress($dest);
206 is $out, "FGHI", ' Merge OK';
210 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
212 my $Error = getErrorRef($CompressClass);
214 title "$CompressClass - Merge to file that doesn't exist";
216 my $out_file = 'abcd.out';
217 my $lex = new LexFile($out_file) ;
219 ok ! -e $out_file, " Destination file, '$out_file', does not exist";
221 ok my $gz1 = $CompressClass->new($out_file, Merge => 1)
222 or die "# $CompressClass->new failed: $GzipError\n";
228 my $out = anyUncompress($out_file);
230 is $out, "FGHI", ' Merged OK';
233 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
235 my $Error = getErrorRef($CompressClass);
237 my $out_file = 'abcde.out';
238 my $lex = new LexFile($out_file) ;
240 foreach my $to_file ( qw( buffer file handle ) )
242 foreach my $content (undef, '', 'x', 'abcde')
244 #next if ! defined $content && $to_file;
247 my $disp_content = defined $content ? $content : '<undef>' ;
248 my $str_content = defined $content ? $content : '' ;
250 if ($to_file eq 'buffer')
254 title "$CompressClass to Buffer, content is '$disp_content'";
258 $buffer = $out_file ;
259 if ($to_file eq 'handle')
261 title "$CompressClass to Filehandle, content is '$disp_content'";
265 title "$CompressClass to File, content is '$disp_content'";
269 my $gz = $CompressClass->new($buffer);
270 my $len = defined $content ? length($content) : 0 ;
271 is $gz->write($content), $len, " write ok";
272 ok $gz->close(), " close ok";
275 is anyUncompress($buffer), $str_content, ' Destination is ok';
279 # next if $TopTypes eq 'RawDeflate' && $content eq '';
284 if ($to_file eq 'handle')
286 $dest = new IO::File "+<$buffer" ;
289 my $gz1 = $CompressClass->new($dest, Merge => 1, AutoClose => 1)
290 or die "## $GzipError\n";
294 is $gz1->write("FGHI"), 4, " write returned 4";
295 ok $gz1->close(), " close ok";
298 my $out = anyUncompress($buffer);
300 is $out, $str_content . "FGHI", ' Merged OK';
308 foreach my $CompressClass ( map { "IO::Compress::$_" } qw( Gzip RawDeflate Deflate) )
310 my $Error = getErrorRef($CompressClass);
312 my $Func = getTopFuncRef($CompressClass);
313 my $TopType = getTopFuncName($CompressClass);
317 my $out_file = 'abcde.out';
318 my $lex = new LexFile($out_file) ;
320 foreach my $to_file (0, 1)
322 foreach my $content (undef, '', 'x', 'abcde')
324 my $disp_content = defined $content ? $content : '<undef>' ;
325 my $str_content = defined $content ? $content : '' ;
329 $buffer = $out_file ;
330 title "$TopType to File, content is '$disp_content'";
336 title "$TopType to Buffer, content is '$disp_content'";
340 ok $Func->(\$content, $buffer), " Compress content";
342 is anyUncompress($buffer), $str_content, ' Destination is ok';
345 ok $Func->(\"FGHI", $buffer, Merge => 1), " Merge content";
348 my $out = anyUncompress($buffer);
350 is $out, $str_content . "FGHI", ' Merged OK';