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 = <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;