10 our ($BadPerl, $UncompressClass);
14 plan(skip_all => "Tied Filehandle needs Perl 5.005 or better" )
17 # use Test::NoWarnings, if available
20 if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
23 $BadPerl = ($] >= 5.006 and $] <= 5.008) ;
32 plan tests => $tests + $extra ;
34 use_ok('Compress::Zlib', 2) ;
39 use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
45 my $filename = shift ;
49 my $fil = new $UncompressClass $filename,
55 $data = $init if defined $init ;
56 1 while $fil->read($data) > 0;
65 my $CompressClass = identify();
66 $UncompressClass = getInverse($CompressClass);
67 my $Error = getErrorRef($CompressClass);
68 my $UnError = getErrorRef($UncompressClass);
74 title "Testing $CompressClass";
78 my $gz = new $CompressClass(\$x);
83 like $@, mkErr("^getc Not Available: File opened only for output");
85 eval { read($gz, $buff, 1) } ;
86 like $@, mkErr("^read Not Available: File opened only for output");
89 like $@, mkErr("^readline Not Available: File opened only for output");
95 $UncompressClass = getInverse($CompressClass);
97 title "Testing $UncompressClass";
100 my $guz = new $CompressClass(\$gc);
105 my $gz = new $UncompressClass(\$gc);
109 eval { print $gz "abc" } ;
110 like $@, mkErr("^print Not Available: File opened only for intput");
112 eval { printf $gz "fmt", "abc" } ;
113 like $@, mkErr("^printf Not Available: File opened only for intput");
115 #eval { write($gz, $buff, 1) } ;
116 #like $@, mkErr("^write Not Available: File opened only for intput");
121 $UncompressClass = getInverse($CompressClass);
123 title "Testing $CompressClass and $UncompressClass";
128 # these tests come almost 100% from IO::String
130 my $lex = new LexFile my $name ;
132 my $io = $CompressClass->new($name);
136 my $heisan = "Heisan\n";
141 is $io->tell(), length($heisan) ;
143 print($io "a", "b", "c");
149 print $io "f", "g", "h";
152 my $foo = "1234567890";
154 ok syswrite($io, $foo, length($foo)) == length($foo) ;
156 { is $io->syswrite($foo, length $foo), length $foo }
158 { is $io->syswrite($foo), length $foo }
159 ok $io->syswrite($foo, length($foo)) == length $foo;
160 ok $io->write($foo, length($foo), 5) == 5;
161 ok $io->write("xxx\n", 100, -1) == 1;
164 printf $io "i(%d)", $_;
165 $io->printf("[%d]\n", $_);
175 is myGZreadFile($name), "Heisan\nabcde\nf,g,h\n" .
176 ("1234567890" x 3) . "67890\n" .
177 "i(1)[1]\ni(2)[2]\ni(3)[3]\n\n";
193 my $lex = new LexFile my $name ;
195 my $iow = new $CompressClass $name ;
202 my $io = new $UncompressClass $name ;
208 or print "# Got " . scalar(@lines) . " lines, expected 6\n" ;
209 is $lines[1], "of a paragraph\n" ;
210 is join('', @lines), $str ;
212 is $io->tell(), length($str) ;
216 ok ! ( defined($io->getline) ||
217 (@tmp = $io->getlines) ||
219 defined($io->getc) ||
220 read($io, $buf, 100) != 0) ;
225 local $/; # slurp mode
226 my $io = $UncompressClass->new($name);
228 my @lines = $io->getlines;
230 ok @lines == 1 && $lines[0] eq $str;
232 $io = $UncompressClass->new($name);
240 local $/ = ""; # paragraph mode
241 my $io = $UncompressClass->new($name);
246 or print "# Got " . scalar(@lines) . " lines, expected 2\n" ;
247 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
248 or print "# $lines[0]\n";
249 ok $lines[1] eq "and a single line.\n\n";
254 my $io = $UncompressClass->new($name);
261 $err++ if $. != ++$no;
268 or print "# Got " . scalar(@lines) . " lines, expected 3\n" ;
269 ok join("-", @lines) eq
270 "This- is- an example\n" .
271 "of a paragraph\n\n\n" .
272 "and a single line.\n\n";
279 my $io = $UncompressClass->new($name);
283 eval { read($io, $buf, -1) } ;
284 like $@, mkErr("length parameter is negative");
287 is read($io, $buf, 0), 0, "Requested 0 bytes" ;
289 ok read($io, $buf, 3) == 3 ;
292 ok sysread($io, $buf, 3, 2) == 3 ;
294 or print "# [$buf]\n" ;;
301 # ok read($io, $buf, 20) == 4 ;
302 # ok $buf eq "e.\n\n";
304 # ok read($io, $buf, 20) == 0 ;
313 # Read from non-compressed file
324 my $lex = new LexFile my $name ;
326 writeFile($name, $str);
330 my $io = new $UncompressClass $name, -Transparent => 1 ;
334 ok $io->tell() == 0 ;
337 ok $lines[1] eq "of a paragraph\n" ;
338 ok join('', @lines) eq $str ;
340 ok $io->tell() == length($str) ;
344 ok ! ( defined($io->getline) ||
345 (@tmp = $io->getlines) ||
347 defined($io->getc) ||
348 read($io, $buf, 100) != 0) ;
353 local $/; # slurp mode
354 my $io = $UncompressClass->new($name);
356 my @lines = $io->getlines;
358 ok @lines == 1 && $lines[0] eq $str;
360 $io = $UncompressClass->new($name);
368 local $/ = ""; # paragraph mode
369 my $io = $UncompressClass->new($name);
374 or print "# exected 2 lines, got " . scalar(@lines) . "\n";
375 ok $lines[0] eq "This is an example\nof a paragraph\n\n\n"
376 or print "# [$lines[0]]\n" ;
377 ok $lines[1] eq "and a single line.\n\n";
382 my $io = $UncompressClass->new($name);
389 $err++ if $. != ++$no;
396 ok join("-", @lines) eq
397 "This- is- an example\n" .
398 "of a paragraph\n\n\n" .
399 "and a single line.\n\n";
406 my $io = $UncompressClass->new($name);
408 ok read($io, $buf, 3) == 3 ;
411 ok sysread($io, $buf, 3, 2) == 3 ;
419 # ok read($io, $buf, 20) == 4 ;
420 # ok $buf eq "e.\n\n";
422 # ok read($io, $buf, 20) == 0 ;
432 # Vary the length parameter in a read
447 foreach my $bufsize (1, 3, 512, 4096, length($str)-1, length($str), length($str)+1)
449 foreach my $trans (0, 1)
451 foreach my $append (0, 1)
453 title "Read Tests - buf length $bufsize, Transparent $trans, Append $append" ;
455 my $lex = new LexFile my $name ;
458 writeFile($name, $str) ;
461 my $iow = new $CompressClass $name ;
467 my $io = $UncompressClass->new($name,
469 -Transparent => $trans);
476 1 while $io->read($buf, $bufsize) > 0;
480 $buf .= $tmp while $io->read($tmp, $bufsize) > 0 ;
482 is length $buf, length $str;