9 our ($BadPerl, $UncompressClass);
13 plan(skip_all => "Extra Tied Filehandle needs Perl 5.6 or better - you have Perl $]" )
18 $BadPerl = ($] >= 5.006 and $] <= 5.008) ;
27 # use Test::NoWarnings, if available
30 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
32 plan tests => $tests + $extra ;
37 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
43 my $filename = shift ;
47 my $fil = new $UncompressClass $filename,
53 $data = $init if defined $init ;
54 1 while $fil->read($data) > 0;
64 my $CompressClass = identify();
65 $UncompressClass = getInverse($CompressClass);
66 my $Error = getErrorRef($CompressClass);
67 my $UnError = getErrorRef($UncompressClass);
70 title "Testing $CompressClass and $UncompressClass";
76 # these tests come almost 100% from IO::String
78 my $lex = new LexFile my $name ;
80 my $io = $CompressClass->new($name);
85 my $heisan = "Heisan\n";
91 is tell($io), length($heisan) ;
92 is $io->tell(), length($heisan) ;
94 $io->print("a", "b", "c");
100 print $io "f", "g", "h";
103 my $foo = "1234567890";
105 ok syswrite($io, $foo, length($foo)) == length($foo) ;
107 { is $io->syswrite($foo, length $foo), length $foo }
109 { is $io->syswrite($foo), length $foo }
110 ok $io->syswrite($foo, length($foo)) == length $foo;
111 ok $io->write($foo, length($foo), 5) == 5;
112 ok $io->write("xxx\n", 100, -1) == 1;
115 printf $io "i(%d)", $_;
116 $io->printf("[%d]\n", $_);
127 is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
128 ("1234567890" x 3) . "67890\n" .
129 "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
145 my $lex = new LexFile my $name ;
147 my $iow = new $CompressClass $name ;
154 my $io = new $UncompressClass $name ;
162 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
163 is $lines[1], "of a paragraph\n" ;
164 is join('', @lines), $str ;
166 #print "TELL says " . tell($io) , " should be ${ \length($str) }\n" ;
167 is $io->tell(), length($str) ;
168 is tell($io), length($str) ;
173 ok ! ( defined($io->getline) ||
174 (@tmp = $io->getlines) ||
176 defined($io->getc) ||
177 read($io, $buf, 100) != 0) ;
182 local $/; # slurp mode
183 my $io = $UncompressClass->new($name);
185 my @lines = $io->getlines;
187 ok @lines == 1 && $lines[0] eq $str;
189 $io = $UncompressClass->new($name);
197 local $/ = ""; # paragraph mode
198 my $io = $UncompressClass->new($name);
203 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
204 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
205 or print "# $lines[0]\n";
206 ok $lines[1] eq "and a single line.\n\n";
211 my $io = $UncompressClass->new($name);
218 $err++ if $. != ++$no;
225 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
226 ok join("-", @lines) eq
227 "This- is- an example\n" .
228 "of a paragraph\n\n\n" .
229 "and a single line.\n\n";
236 my $io = $UncompressClass->new($name);
238 ok $io, "opened ok" ;
240 #eval { read($io, $buf, -1); } ;
241 #like $@, mkErr("length parameter is negative"), "xxx $io $UncompressClass $RawInflateError" ;
243 #eval { read($io, 1) } ;
244 #like $@, mkErr("buffer parameter is read-only");
246 is read($io, $buf, 0), 0, "Requested 0 bytes" ;
248 ok read($io, $buf, 3) == 3 ;
251 ok sysread($io, $buf, 3, 2) == 3 ;
253 or print "# [$buf]\n" ;;
260 # ok read($io, $buf, 20) == 4 ;
261 # ok $buf eq "e.\n\n";
263 # ok read($io, $buf, 20) == 0 ;
276 my $lex = new LexFile my $name ;
278 my $first = "beginning" ;
279 my $last = "the end" ;
280 my $iow = new $CompressClass $name ;
282 ok seek $iow, 10, SEEK_CUR ;
283 is tell($iow), length($first)+10;
284 ok $iow->seek(0, SEEK_CUR) ;
285 is tell($iow), length($first)+10;
289 my $io = $UncompressClass->new($name);
290 ok myGZreadFile($name) eq $first . "\x00" x 10 . $last ;
292 $io = $UncompressClass->new($name);
293 ok seek $io, length($first)+10, SEEK_CUR ;
295 is tell($io), length($first)+10;
296 ok seek $io, 0, SEEK_CUR ;
297 is tell($io), length($first)+10;
299 ok read $io, $buff, 100 ;
308 my $a = new $CompressClass(\$b) ;
311 eval { seek($a, -1, 10) ; };
312 like $@, mkErr("seek: unknown value, 10, for whence parameter");
314 eval { seek($a, -1, SEEK_END) ; };
315 like $@, mkErr("cannot seek backwards");
321 my $u = new $UncompressClass(\$b) ;
323 eval { seek($u, -1, 10) ; };
324 like $@, mkErr("seek: unknown value, 10, for whence parameter");
326 eval { seek($u, -1, SEEK_END) ; };
327 like $@, mkErr("seek: SEEK_END not allowed");
329 eval { seek($u, -1, SEEK_CUR) ; };
330 like $@, mkErr("cannot seek backwards");
336 my $lex = new LexFile my $name ;
345 ok $fh = new IO::File ">$name" ;
347 ok $x = new $CompressClass $fh ;
349 ok $x->fileno() == fileno($fh) ;
350 ok $x->fileno() == fileno($x) ;
351 ok $x->write($hello) ;
359 ok my $fh1 = new IO::File "<$name" ;
360 ok $x = new $UncompressClass $fh1, -Append => 1 ;
361 ok $x->fileno() == fileno $fh1 ;
362 ok $x->fileno() == fileno $x ;
364 1 while $x->read($uncomp) > 0 ;
369 ok $hello eq $uncomp ;