03zlib-v1.t

source of perl for linux application,

BEGIN {
    if ($ENV{PERL_CORE}) {
	chdir 't' if -d 't';
	@INC = ("../lib", "lib/compress");
    }
}

use lib qw(t t/compress);
use strict;
use warnings;
use bytes;

use Test::More ;
use CompTestUtils;
use Symbol;

BEGIN 
{ 
    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if eval { require Test::NoWarnings ;  import Test::NoWarnings; 1 };

    my $count = 0 ;
    if ($] < 5.005) {
        $count = 390 ;
    }
    else {
        $count = 401 ;
    }


    plan tests => $count + $extra ;

    use_ok('Compress::Zlib', 2) ;
    use_ok('IO::Compress::Gzip::Constants') ;

    use_ok('IO::Compress::Gzip', qw($GzipError)) ;
}


my $hello = <<EOM ;
hello world
this is a test
EOM

my $len   = length $hello ;

# Check zlib_version and ZLIB_VERSION are the same.
is Compress::Zlib::zlib_version, ZLIB_VERSION, 
    "ZLIB_VERSION matches Compress::Zlib::zlib_version" ;

# generate a long random string
my $contents = '' ;
foreach (1 .. 5000)
  { $contents .= chr int rand 256 }

my $x ;
my $fil;

# compress/uncompress tests
# =========================

eval { compress([1]); };
ok $@ =~ m#not a scalar reference#
    or print "# $@\n" ;;

eval { uncompress([1]); };
ok $@ =~ m#not a scalar reference#
    or print "# $@\n" ;;

$hello = "hello mum" ;
my $keep_hello = $hello ;

my $compr = compress($hello) ;
ok $compr ne "" ;

my $keep_compr = $compr ;

my $uncompr = uncompress ($compr) ;

ok $hello eq $uncompr ;

ok $hello eq $keep_hello ;
ok $compr eq $keep_compr ;

# compress a number
$hello = 7890 ;
$keep_hello = $hello ;

$compr = compress($hello) ;
ok $compr ne "" ;

$keep_compr = $compr ;

$uncompr = uncompress ($compr) ;

ok $hello eq $uncompr ;

ok $hello eq $keep_hello ;
ok $compr eq $keep_compr ;

# bigger compress

$compr = compress ($contents) ;
ok $compr ne "" ;

$uncompr = uncompress ($compr) ;

ok $contents eq $uncompr ;

# buffer reference

$compr = compress(\$hello) ;
ok $compr ne "" ;


$uncompr = uncompress (\$compr) ;
ok $hello eq $uncompr ;

# bad level
$compr = compress($hello, 1000) ;
ok ! defined $compr;

# change level
$compr = compress($hello, Z_BEST_COMPRESSION) ;
ok defined $compr;
$uncompr = uncompress (\$compr) ;
ok $hello eq $uncompr ;

# corrupt data
$compr = compress(\$hello) ;
ok $compr ne "" ;

substr($compr,0, 1) = "\xFF";
ok !defined uncompress (\$compr) ;

# deflate/inflate - small buffer
# ==============================

$hello = "I am a HAL 9000 computer" ;
my @hello = split('', $hello) ;
my ($err, $X, $status);
 
ok  (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
ok $x ;
ok $err == Z_OK ;
 
my $Answer = '';
foreach (@hello)
{
    ($X, $status) = $x->deflate($_) ;
    last unless $status == Z_OK ;

    $Answer .= $X ;
}
 
ok $status == Z_OK ;

ok    ((($X, $status) = $x->flush())[1] == Z_OK ) ;
$Answer .= $X ;
 
 
my @Answer = split('', $Answer) ;
 
my $k;
ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
ok $k ;
ok $err == Z_OK ;
 
my $GOT = '';
my $Z;
foreach (@Answer)
{
    ($Z, $status) = $k->inflate($_) ;
    $GOT .= $Z ;
    last if $status == Z_STREAM_END or $status != Z_OK ;
 
}
 
ok $status == Z_STREAM_END ;
ok $GOT eq $hello ;


title 'deflate/inflate - small buffer with a number';
# ==============================

$hello = 6529 ;
 
ok (($x, $err) = deflateInit( {-Bufsize => 1} ) ) ;
ok $x ;
ok $err == Z_OK ;
 
ok !defined $x->msg() ;
ok $x->total_in() == 0 ;
ok $x->total_out() == 0 ;
$Answer = '';
{
    ($X, $status) = $x->deflate($hello) ;

    $Answer .= $X ;
}
 
ok $status == Z_OK ;

ok   ((($X, $status) = $x->flush())[1] == Z_OK ) ;
$Answer .= $X ;
 
ok !defined $x->msg() ;
ok $x->total_in() == length $hello ;
ok $x->total_out() == length $Answer ;

 
@Answer = split('', $Answer) ;
 
ok (($k, $err) = inflateInit( {-Bufsize => 1}) ) ;
ok $k ;
ok $err == Z_OK ;

ok !defined $k->msg() ;
ok $k->total_in() == 0 ;
ok $k->total_out() == 0 ;
 
$GOT = '';
foreach (@Answer)
{
    ($Z, $status) = $k->inflate($_) ;
    $GOT .= $Z ;
    last if $status == Z_STREAM_END or $status != Z_OK ;
 
}
 
ok $status == Z_STREAM_END ;
ok $GOT eq $hello ;

ok !defined $k->msg() ;
is $k->total_in(), length $Answer ;
ok $k->total_out() == length $hello ;


 
title 'deflate/inflate - larger buffer';
# ==============================


ok $x = deflateInit() ;
 
ok ((($X, $status) = $x->deflate($contents))[1] == Z_OK) ;

my $Y = $X ;
 
 
ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
$Y .= $X ;
 
 
 
ok $k = inflateInit() ;
 
($Z, $status) = $k->inflate($Y) ;
 
ok $status == Z_STREAM_END ;
ok $contents eq $Z ;

title 'deflate/inflate - preset dictionary';
# ===================================

my $dictionary = "hello" ;
ok $x = deflateInit({-Level => Z_BEST_COMPRESSION,
			 -Dictionary => $dictionary}) ;
 
my $dictID = $x->dict_adler() ;

($X, $status) = $x->deflate($hello) ;
ok $status == Z_OK ;
($Y, $status) = $x->flush() ;
ok $status == Z_OK ;
$X .= $Y ;
$x = 0 ;
 
ok $k = inflateInit(-Dictionary => $dictionary) ;
 
($Z, $status) = $k->inflate($X);
ok $status == Z_STREAM_END ;
ok $k->dict_adler() == $dictID;
ok $hello eq $Z ;

#$Z='';
#while (1) {
#    ($Z, $status) = $k->inflate($X) ;
#    last if $status == Z_STREAM_END or $status != Z_OK ;
#print "status=[$status] hello=[$hello] Z=[$Z]\n";
#}
#ok $status == Z_STREAM_END ;
#ok $hello eq $Z  
# or print "status=[$status] hello=[$hello] Z=[$Z]\n";






title 'inflate - check remaining buffer after Z_STREAM_END';
# ===================================================
 
{
    ok $x = deflateInit(-Level => Z_BEST_COMPRESSION ) ;
 
    ($X, $status) = $x->deflate($hello) ;
    ok $status == Z_OK ;
    ($Y, $status) = $x->flush() ;
    ok $status == Z_OK ;
    $X .= $Y ;
    $x = 0 ;
 
    ok $k = inflateInit()  ;
 
    my $first = substr($X, 0, 2) ;
    my $last  = substr($X, 2) ;
    ($Z, $status) = $k->inflate($first);
    ok $status == Z_OK ;
    ok $first eq "" ;

    $last .= "appendage" ;
    my $T;
    ($T, $status) = $k->inflate($last);
    ok $status == Z_STREAM_END ;
    ok $hello eq $Z . $T ;
    ok $last eq "appendage" ;

}

title 'memGzip & memGunzip';
{
    my $name = "test.gz" ;
    my $buffer = <<EOM;
some sample 
text

EOM

    my $len = length $buffer ;
    my ($x, $uncomp) ;


    # create an in-memory gzip file
    my $dest = Compress::Zlib::memGzip($buffer) ;
    ok length $dest ;

    # write it to disk
    ok open(FH, ">$name") ;
    binmode(FH);
    print FH $dest ;
    close FH ;

    # uncompress with gzopen
    ok my $fil = gzopen($name, "rb") ;
 
    is $fil->gzread($uncomp, 0), 0 ;
    ok (($x = $fil->gzread($uncomp)) == $len) ;
 
    ok ! $fil->gzclose ;

    ok $uncomp eq $buffer ;
 
    1 while unlink $name ;

    # now check that memGunzip can deal with it.
    my $ungzip = Compress::Zlib::memGunzip($dest) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
 
    # now do the same but use a reference 

    $dest = Compress::Zlib::memGzip(\$buffer) ; 
    ok length $dest ;

    # write it to disk
    ok open(FH, ">$name") ;
    binmode(FH);
    print FH $dest ;
    close FH ;

    # uncompress with gzopen
    ok $fil = gzopen($name, "rb") ;
 
    ok (($x = $fil->gzread($uncomp)) == $len) ;
 
    ok ! $fil->gzclose ;

    ok $uncomp eq $buffer ;
 
    # now check that memGunzip can deal with it.
    my $keep = $dest;
    $ungzip = Compress::Zlib::memGunzip(\$dest) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    # check memGunzip can cope with missing gzip trailer
    my $minimal = substr($keep, 0, -1) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -2) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -3) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -4) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -5) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -6) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -7) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -8) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

    $minimal = substr($keep, 0, -9) ;
    $ungzip = Compress::Zlib::memGunzip(\$minimal) ;
    ok ! defined $ungzip ;

 
    1 while unlink $name ;

    # check corrupt header -- too short
    $dest = "x" ;
    my $result = Compress::Zlib::memGunzip($dest) ;
    ok !defined $result ;

    # check corrupt header -- full of junk
    $dest = "x" x 200 ;
    $result = Compress::Zlib::memGunzip($dest) ;
    ok !defined $result ;

    # corrupt header - 1st byte wrong
    my $bad = $keep ;
    substr($bad, 0, 1) = "\xFF" ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;

    # corrupt header - 2st byte wrong
    $bad = $keep ;
    substr($bad, 1, 1) = "\xFF" ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;

    # corrupt header - method not deflated
    $bad = $keep ;
    substr($bad, 2, 1) = "\xFF" ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;

    # corrupt header - reserverd bits used
    $bad = $keep ;
    substr($bad, 3, 1) = "\xFF" ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;

    # corrupt trailer - length wrong
    $bad = $keep ;
    substr($bad, -8, 4) = "\xFF" x 4 ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;

    # corrupt trailer - CRC wrong
    $bad = $keep ;
    substr($bad, -4, 4) = "\xFF" x 4 ;
    $ungzip = Compress::Zlib::memGunzip(\$bad) ;
    ok ! defined $ungzip ;
}

{
    title "Check all bytes can be handled";

    my $lex = new LexFile my $name ;
    my $data = join '', map { chr } 0x00 .. 0xFF;
    $data .= "\r\nabd\r\n";

    my $fil;
    ok $fil = gzopen($name, "wb") ;
    is $fil->gzwrite($data), length $data ;
    ok ! $fil->gzclose();

    my $input;
    ok $fil = gzopen($name, "rb") ;
    is $fil->gzread($input), length $data ;
    ok ! $fil->gzclose();
    ok $input eq $data;

    title "Check all bytes can be handled - transparent mode";
    writeFile($name, $data);
    ok $fil = gzopen($name, "rb") ;
    is $fil->gzread($input), length $data ;
    ok ! $fil->gzclose();
    ok $input eq $data;

}

title 'memGunzip with a gzopen created file';
{
    my $name = "test.gz" ;
    my $buffer = <<EOM;
some sample 
text

EOM

    ok $fil = gzopen($name, "wb") ;

    ok $fil->gzwrite($buffer) == length $buffer ;

    ok ! $fil->gzclose ;

    my $compr = readFile($name);
    ok length $compr ;
    my $unc = Compress::Zlib::memGunzip($compr) ;
    ok defined $unc ;
    ok $buffer eq $unc ;
    1 while unlink $name ;
}

{

    # Check - MAX_WBITS
    # =================
    
    $hello = "Test test test test test";
    @hello = split('', $hello) ;
     
    ok (($x, $err) = deflateInit( -Bufsize => 1, -WindowBits => -MAX_WBITS() ) ) ;
    ok $x ;
    ok $err == Z_OK ;
     
    $Answer = '';
    foreach (@hello)
    {
        ($X, $status) = $x->deflate($_) ;
        last unless $status == Z_OK ;
    
        $Answer .= $X ;
    }
     
    ok $status == Z_OK ;
    
    ok   ((($X, $status) = $x->flush())[1] == Z_OK ) ;
    $Answer .= $X ;
     
     
    @Answer = split('', $Answer) ;
    # Undocumented corner -- extra byte needed to get inflate to return 
    # Z_STREAM_END when done.  
    push @Answer, " " ; 
     
    ok (($k, $err) = inflateInit(-Bufsize => 1, -WindowBits => -MAX_WBITS()) ) ;
    ok $k ;
    ok $err == Z_OK ;
     
    $GOT = '';
    foreach (@Answer)
    {
        ($Z, $status) = $k->inflate($_) ;
        $GOT .= $Z ;
        last if $status == Z_STREAM_END or $status != Z_OK ;
     
    }
     
    ok $status == Z_STREAM_END ;
    ok $GOT eq $hello ;
    
}

{
    # inflateSync