use strict;
use warnings;
use bytes;
use Test::More ;
use CompTestUtils;
BEGIN
{
# use Test::NoWarnings, if available
my $extra = 0 ;
$extra = 1
if eval { require Test::NoWarnings ; import Test::NoWarnings; 1 };
plan tests => 49 + $extra ;
}
my $CompressClass = identify();
my $UncompressClass = getInverse($CompressClass);
my $Error = getErrorRef($CompressClass);
my $UnError = getErrorRef($UncompressClass);
use Compress::Raw::Zlib;
use IO::Handle qw(SEEK_SET SEEK_CUR SEEK_END);
sub myGZreadFile
{
my $filename = shift ;
my $init = shift ;
my $fil = new $UncompressClass $filename,
-Strict => 1,
-Append => 1
;
my $data = '';
$data = $init if defined $init ;
1 while $fil->read($data) > 0;
$fil->close ;
return $data ;
}
{
title "Testing $CompressClass Errors";
}
{
title "Testing $UncompressClass Errors";
}
{
title "Testing $CompressClass and $UncompressClass";
{
title "flush" ;
my $lex = new LexFile my $name ;
my $hello = <<EOM ;
hello world
this is a test
EOM
{
my $x ;
ok $x = new $CompressClass $name ;
ok $x->write($hello), "write" ;
ok $x->flush(Z_FINISH), "flush";
ok $x->close, "close" ;
}
{
my $uncomp;
ok my $x = new $UncompressClass $name, -Append => 1 ;
my $len ;
1 while ($len = $x->read($uncomp)) > 0 ;
is $len, 0, "read returned 0";
ok $x->close ;
is $uncomp, $hello ;
}
}
if ($CompressClass ne 'RawDeflate')
{
# write empty file
#========================================
my $buffer = '';
{
my $x ;
ok $x = new $CompressClass(\$buffer) ;
ok $x->close ;
}
my $keep = $buffer ;
my $uncomp= '';
{
my $x ;
ok $x = new $UncompressClass(\$buffer, Append => 1) ;
1 while $x->read($uncomp) > 0 ;
ok $x->close ;
}
ok $uncomp eq '' ;
ok $buffer eq $keep ;
}
{
title "inflateSync on plain file";
my $hello = "I am a HAL 9000 computer" x 2001 ;
my $k = new $UncompressClass(\$hello, Transparent => 1);
ok $k ;
# Skip to the flush point -- no-op for plain file
my $status = $k->inflateSync();
is $status, 1
or diag $k->error() ;
my $rest;
is $k->read($rest, length($hello)), length($hello)
or diag $k->error() ;
ok $rest eq $hello ;
ok $k->close();
}
{
title "$CompressClass: inflateSync for real";
# create a deflate stream with flush points
my $hello = "I am a HAL 9000 computer" x 2001 ;
my $goodbye = "Will I dream?" x 2010;
my ($x, $err, $answer, $X, $Z, $status);
my $Answer ;
ok ($x = new $CompressClass(\$Answer));
ok $x ;
is $x->write($hello), length($hello);
# create a flush point
ok $x->flush(Z_FULL_FLUSH) ;
is $x->write($goodbye), length($goodbye);
ok $x->close() ;
my $k;
$k = new $UncompressClass(\$Answer, BlockSize => 1);
ok $k ;
my $initial;
is $k->read($initial, 1), 1 ;
is $initial, substr($hello, 0, 1);
# Skip to the flush point
$status = $k->inflateSync();
is $status, 1, " inflateSync returned 1"
or diag $k->error() ;
my $rest;
is $k->read($rest, length($hello) + length($goodbye)),
length($goodbye)
or diag $k->error() ;
ok $rest eq $goodbye, " got expected output" ;
ok $k->close();
}
{
title "$CompressClass: inflateSync no FLUSH point";
# create a deflate stream with flush points
my $hello = "I am a HAL 9000 computer" x 2001 ;
my ($x, $err, $answer, $X, $Z, $status);
my $Answer ;
ok ($x = new $CompressClass(\$Answer));
ok $x ;
is $x->write($hello), length($hello);
ok $x->close() ;
my $k = new $UncompressClass(\$Answer, BlockSize => 1);
ok $k ;
my $initial;
is $k->read($initial, 1), 1 ;
is $initial, substr($hello, 0, 1);
# Skip to the flush point
$status = $k->inflateSync();
is $status, 0
or diag $k->error() ;
ok $k->close();
is $k->inflateSync(), 0 ;
}
}
1;