20 plan(skip_all => "Extra Tied Filehandle needs Perl 5.6 or better - you have Perl $]" )
25 $BadPerl = ($] >= 5.006 or $] <= 5.008) ;
34 # use Test::NoWarnings, if available
37 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
39 plan tests => $tests + $extra ;
41 use_ok('Compress::Zlib', 2) ;
43 use_ok('IO::Compress::Gzip', qw($GzipError)) ;
44 use_ok('IO::Uncompress::Gunzip', qw($GunzipError)) ;
46 use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
47 use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;
49 use_ok('IO::Compress::RawDeflate', qw($RawDeflateError)) ;
50 use_ok('IO::Uncompress::RawInflate', qw($RawInflateError)) ;
56 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
59 our ($UncompressClass);
64 my $filename = shift ;
68 my $fil = new $UncompressClass $filename,
74 $data = $init if defined $init ;
75 1 while $fil->read($data) > 0;
81 # Check zlib_version and ZLIB_VERSION are the same.
82 is Compress::Zlib::zlib_version, ZLIB_VERSION,
83 "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;
87 foreach my $CompressClass ('IO::Compress::Gzip',
88 'IO::Compress::Deflate',
89 'IO::Compress::RawDeflate',
92 $UncompressClass = getInverse($CompressClass);
94 title "Testing $CompressClass and $UncompressClass";
100 # these tests come almost 100% from IO::String
102 my $name = "test.gz" ;
103 my $lex = new LexFile $name ;
105 my $io = $CompressClass->new($name);
110 my $heisan = "Heisan\n";
116 is tell($io), length($heisan) ;
117 is $io->tell(), length($heisan) ;
119 $io->print("a", "b", "c");
125 print $io "f", "g", "h";
128 my $foo = "1234567890";
130 ok syswrite($io, $foo, length($foo)) == length($foo) ;
132 { is $io->syswrite($foo, length $foo), length $foo }
134 { is $io->syswrite($foo), length $foo }
135 ok $io->syswrite($foo, length($foo)) == length $foo;
136 ok $io->write($foo, length($foo), 5) == 5;
137 ok $io->write("xxx\n", 100, -1) == 1;
140 printf $io "i(%d)", $_;
141 $io->printf("[%d]\n", $_);
152 is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
153 ("1234567890" x 3) . "67890\n" .
154 "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
170 my $name = "test.gz" ;
171 my $lex = new LexFile $name ;
173 my $iow = new $CompressClass $name ;
180 my $io = new $UncompressClass $name ;
188 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
189 is $lines[1], "of a paragraph\n" ;
190 is join('', @lines), $str ;
192 #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ;
193 is $io->tell(), length($str) ;
194 is tell($io), length($str) ;
199 ok ! ( defined($io->getline) ||
200 (@tmp = $io->getlines) ||
202 defined($io->getc) ||
203 read($io, $buf, 100) != 0) ;
208 local $/; # slurp mode
209 my $io = $UncompressClass->new($name);
211 my @lines = $io->getlines;
213 ok @lines == 1 && $lines[0] eq $str;
215 $io = $UncompressClass->new($name);
223 local $/ = ""; # paragraph mode
224 my $io = $UncompressClass->new($name);
229 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
230 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
231 or print "# $lines[0]\n";
232 ok $lines[1] eq "and a single line.\n\n";
237 my $io = $UncompressClass->new($name);
244 $err++ if $. != ++$no;
251 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
252 ok join("-", @lines) eq
253 "This- is- an example\n" .
254 "of a paragraph\n\n\n" .
255 "and a single line.\n\n";
262 my $io = $UncompressClass->new($name);
264 ok $io, "opened ok" ;
266 #eval { read($io, $buf, -1); } ;
267 #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ;
269 #eval { read($io, 1) } ;
270 #like $@, mkErr("buffer parameter is read-only");
272 is read($io, $buf, 0), 0, "Requested 0 bytes" ;
274 ok read($io, $buf, 3) == 3 ;
277 ok sysread($io, $buf, 3, 2) == 3 ;
279 or print "# [$buf]\n" ;;
286 # ok read($io, $buf, 20) == 4 ;
287 # ok $buf eq "e.\n\n";
289 # ok read($io, $buf, 20) == 0 ;
302 my $name = "test.gz" ;
303 my $lex = new LexFile $name ;
305 my $first = "beginning" ;
306 my $last = "the end" ;
307 my $iow = new $CompressClass $name ;
309 ok seek $iow, 10, SEEK_CUR ;
310 is tell($iow), length($first)+10;
311 ok $iow->seek(0, SEEK_CUR) ;
312 is tell($iow), length($first)+10;
316 my $io = $UncompressClass->new($name);
317 ok myGZreadFile($name) eq $first . "\x00" x 10 . $last ;
319 $io = $UncompressClass->new($name);
320 ok seek $io, length($first)+10, SEEK_CUR ;
322 is tell($io), length($first)+10;
323 ok seek $io, 0, SEEK_CUR ;
324 is tell($io), length($first)+10;
326 ok read $io, $buff, 100 ;
335 my $a = new $CompressClass(\$b) ;
338 eval { seek($a, -1, 10) ; };
339 like $@, mkErr("^seek: unknown value, 10, for whence parameter");
341 eval { seek($a, -1, SEEK_END) ; };
342 like $@, mkErr("^cannot seek backwards");
348 my $u = new $UncompressClass(\$b) ;
350 eval { seek($u, -1, 10) ; };
351 like $@, mkErr("^seek: unknown value, 10, for whence parameter");
353 eval { seek($u, -1, SEEK_END) ; };
354 like $@, mkErr("^seek: SEEK_END not allowed");
356 eval { seek($u, -1, SEEK_CUR) ; };
357 like $@, mkErr("^cannot seek backwards");
363 my $name = "test.gz" ;
364 my $lex = new LexFile $name ;
373 ok $fh = new IO::File ">$name" ;
375 ok $x = new $CompressClass $fh ;
377 ok $x->fileno() == fileno($fh) ;
378 ok $x->fileno() == fileno($x) ;
379 ok $x->write($hello) ;
387 ok my $fh1 = new IO::File "<$name" ;
388 ok $x = new $UncompressClass $fh1, -Append => 1 ;
389 ok $x->fileno() == fileno $fh1 ;
390 ok $x->fileno() == fileno $x ;
392 1 while $x->read($uncomp) > 0 ;
397 ok $hello eq $uncomp ;