cpan/IO-Compress/t/cz-03zlib-v1.t

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 = 445 ;
    }
    else {
        $count = 456 ;
    }


    plan tests => $count + $extra ;

    use_ok('Compress::Zlib', qw(:ALL memGunzip memGzip zlib_version));
    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.
SKIP: {
    skip "TEST_SKIP_VERSION_CHECK is set", 1 
        if $ENV{TEST_SKIP_VERSION_CHECK};
    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 = memGzip($buffer) ;
    ok length $dest ;
    is $gzerrno, 0;

    # 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 = memGunzip($dest) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;
 
    # now do the same but use a reference 

    $dest = memGzip(\$buffer) ; 
    ok length $dest ;
    is $gzerrno, 0;

    # 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 = memGunzip(\$dest) ;
    is $gzerrno, 0;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;

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

    $minimal = substr($keep, 0, -2) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -3) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -4) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -5) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -6) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -7) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -8) ;
    $ungzip = memGunzip(\$minimal) ;
    ok defined $ungzip ;
    ok $buffer eq $ungzip ;
    is $gzerrno, 0;

    $minimal = substr($keep, 0, -9) ;
    $ungzip = memGunzip(\$minimal) ;
    ok ! defined $ungzip ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;

 
    1 while unlink $name ;

    # check corrupt header -- too short
    $dest = "x" ;
    my $result = memGunzip($dest) ;
    ok !defined $result ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;

    # check corrupt header -- full of junk
    $dest = "x" x 200 ;
    $result = memGunzip($dest) ;
    ok !defined $result ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;

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

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

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

    # corrupt header - reserved bits used
    $bad = $keep ;
    substr($bad, 3, 1) = "\xFF" ;
    $ungzip = memGunzip(\$bad) ;
    ok ! defined $ungzip ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;

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

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

{
    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 = memGunzip($compr) ;
    is $gzerrno, 0;
    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

    # 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 ($err, $answer, $X, $status, $Answer);
     
    ok (($x, $err) = deflateInit() ) ;
    ok $x ;
    ok $err == Z_OK ;
     
    ($Answer, $status) = $x->deflate($hello) ;
    ok $status == Z_OK ;
    
    # create a flush point
    ok ((($X, $status) = $x->flush(Z_FULL_FLUSH))[1] == Z_OK ) ;
    $Answer .= $X ;
     
    ($X, $status) = $x->deflate($goodbye) ;
    ok $status == Z_OK ;
    $Answer .= $X ;
    
    ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
    $Answer .= $X ;
     
    my ($first, @Answer) = split('', $Answer) ;
     
    my $k;
    ok (($k, $err) = inflateInit()) ;
    ok $k ;
    ok $err == Z_OK ;
     
    ($Z, $status) = $k->inflate($first) ;
    ok $status == Z_OK ;

    # skip to the first flush point.
    while (@Answer)
    {
        my $byte = shift @Answer;
        $status = $k->inflateSync($byte) ;
        last unless $status == Z_DATA_ERROR;
     
    }

    ok $status == Z_OK;
     
    my $GOT = '';
    my $Z = '';
    foreach (@Answer)
    {
        my $Z = '';
        ($Z, $status) = $k->inflate($_) ;
        $GOT .= $Z if defined $Z ;
        # print "x $status\n";
        last if $status == Z_STREAM_END or $status != Z_OK ;
     
    }
     
    # zlib 1.0.9 returns Z_STREAM_END here, all others return Z_DATA_ERROR
    ok $status == Z_DATA_ERROR || $status == Z_STREAM_END ;
    ok $GOT eq $goodbye ;


    # Check inflateSync leaves good data in buffer
    $Answer =~ /^(.)(.*)$/ ;
    my ($initial, $rest) = ($1, $2);

    
    ok (($k, $err) = inflateInit()) ;
    ok $k ;
    ok $err == Z_OK ;
     
    ($Z, $status) = $k->inflate($initial) ;
    ok $status == Z_OK ;

    $status = $k->inflateSync($rest) ;
    ok $status == Z_OK;
     
    ($GOT, $status) = $k->inflate($rest) ;
     
    ok $status == Z_DATA_ERROR ;
    ok $Z . $GOT eq $goodbye ;
}

{
    # deflateParams

    my $hello = "I am a HAL 9000 computer" x 2001 ;
    my $goodbye = "Will I dream?" x 2010;
    my ($input, $err, $answer, $X, $status, $Answer);
     
    ok (($x, $err) = deflateInit(-Level    => Z_BEST_COMPRESSION,
                                     -Strategy => Z_DEFAULT_STRATEGY) ) ;
    ok $x ;
    ok $err == Z_OK ;

    ok $x->get_Level()    == Z_BEST_COMPRESSION;
    ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
     
    ($Answer, $status) = $x->deflate($hello) ;
    ok $status == Z_OK ;
    $input .= $hello;
    
    # error cases
    eval { $x->deflateParams() };
    #like $@, mkErr("^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy");
    like $@, "/^Compress::Raw::Zlib::deflateParams needs Level and/or Strategy/";

    eval { $x->deflateParams(-Joe => 3) };
    like $@, "/^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value/";
    #like $@, mkErr("^Compress::Raw::Zlib::deflateStream::deflateParams: unknown key value(s) Joe");
    #ok $@ =~ /^Compress::Zlib::deflateStream::deflateParams: unknown key value\(s\) Joe at/
    #    or print "# $@\n" ;

    ok $x->get_Level()    == Z_BEST_COMPRESSION;
    ok $x->get_Strategy() == Z_DEFAULT_STRATEGY;
     
    # change both Level & Strategy
    $status = $x->deflateParams(-Level => Z_BEST_SPEED, -Strategy => Z_HUFFMAN_ONLY) ;
    ok $status == Z_OK ;
    
    ok $x->get_Level()    == Z_BEST_SPEED;
    ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
     
    ($X, $status) = $x->deflate($goodbye) ;
    ok $status == Z_OK ;
    $Answer .= $X ;
    $input .= $goodbye;
    
    # change only Level 
    $status = $x->deflateParams(-Level => Z_NO_COMPRESSION) ;
    ok $status == Z_OK ;
    
    ok $x->get_Level()    == Z_NO_COMPRESSION;
    ok $x->get_Strategy() == Z_HUFFMAN_ONLY;
     
    ($X, $status) = $x->deflate($goodbye) ;
    ok $status == Z_OK ;
    $Answer .= $X ;
    $input .= $goodbye;
    
    # change only Strategy
    $status = $x->deflateParams(-Strategy => Z_FILTERED) ;
    ok $status == Z_OK ;
    
    ok $x->get_Level()    == Z_NO_COMPRESSION;
    ok $x->get_Strategy() == Z_FILTERED;
     
    ($X, $status) = $x->deflate($goodbye) ;
    ok $status == Z_OK ;
    $Answer .= $X ;
    $input .= $goodbye;
    
    ok ((($X, $status) = $x->flush())[1] == Z_OK ) ;
    $Answer .= $X ;
     
    my ($first, @Answer) = split('', $Answer) ;
     
    my $k;
    ok (($k, $err) = inflateInit()) ;
    ok $k ;
    ok $err == Z_OK ;
     
    ($Z, $status) = $k->inflate($Answer) ;

    ok $status == Z_STREAM_END 
        or print "# status $status\n";
    ok $Z  eq $input ;
}

{
    # error cases

    eval { deflateInit(-Level) };
    like $@, '/^Compress::Zlib::deflateInit: Expected even number of parameters, got 1/';

    eval { inflateInit(-Level) };
    like $@, '/^Compress::Zlib::inflateInit: Expected even number of parameters, got 1/';

    eval { deflateInit(-Joe => 1) };
    ok $@ =~ /^Compress::Zlib::deflateInit: unknown key value\(s\) Joe at/;

    eval { inflateInit(-Joe => 1) };
    ok $@ =~ /^Compress::Zlib::inflateInit: unknown key value\(s\) Joe at/;

    eval { deflateInit(-Bufsize => 0) };
    ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;

    eval { inflateInit(-Bufsize => 0) };
    ok $@ =~ /^.*?: Bufsize must be >= 1, you specified 0 at/;

    eval { deflateInit(-Bufsize => -1) };
    #ok $@ =~ /^.*?: Bufsize must be >= 1, you specified -1 at/;
    ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;

    eval { inflateInit(-Bufsize => -1) };
    ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got '-1'/;

    eval { deflateInit(-Bufsize => "xxx") };
    ok $@ =~ /^Compress::Zlib::deflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;

    eval { inflateInit(-Bufsize => "xxx") };
    ok $@ =~ /^Compress::Zlib::inflateInit: Parameter 'Bufsize' must be an unsigned int, got 'xxx'/;

    eval { gzopen([], 0) ; }  ;
    ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
	or print "# $@\n" ;

#    my $x = Symbol::gensym() ;
#    eval { gzopen($x, 0) ; }  ;
#    ok $@ =~ /^gzopen: file parameter is not a filehandle or filename at/
#	or print "# $@\n" ;

}

if ($] >= 5.005)
{
    # test inflate with a substr

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

     
     
    ok ((($X, $status) = $x->flush() )[1] == Z_OK ) ;
    $Y .= $X ;
     
    my $append = "Appended" ;
    $Y .= $append ;
     
    ok $k = inflateInit() ;
     
    #($Z, $status) = $k->inflate(substr($Y, 0, -1)) ;
    ($Z, $status) = $k->inflate(substr($Y, 0)) ;
     
    ok $status == Z_STREAM_END ;
    ok $contents eq $Z ;
    is $Y, $append;
    
}

if ($] >= 5.005)
{
    # deflate/inflate in scalar context

    ok my $x = deflateInit() ;
     
    my $X = $x->deflate($contents);
    
    my $Y = $X ;

     
     
    $X = $x->flush();
    $Y .= $X ;
     
    my $append = "Appended" ;
    $Y .= $append ;
     
    ok $k = inflateInit() ;
     
    $Z = $k->inflate(substr($Y, 0, -1)) ;
    #$Z = $k->inflate(substr($Y, 0)) ;
     
    ok $contents eq $Z ;
    is $Y, $append;
    
}

{
    title 'CRC32' ;

    # CRC32 of this data should have the high bit set
    # value in ascii is ZgRNtjgSUW
    my $data = "\x5a\x67\x52\x4e\x74\x6a\x67\x53\x55\x57"; 
    my $expected_crc = 0xCF707A2B ; # 3480255019 

    my $crc = crc32($data) ;
    is $crc, $expected_crc;
}

{
    title 'Adler32' ;

    # adler of this data should have the high bit set
    # value in ascii is lpscOVsAJiUfNComkOfWYBcPhHZ[bT
    my $data = "\x6c\x70\x73\x63\x4f\x56\x73\x41\x4a\x69\x55\x66" .
               "\x4e\x43\x6f\x6d\x6b\x4f\x66\x57\x59\x42\x63\x50" .
               "\x68\x48\x5a\x5b\x62\x54";
    my $expected_crc = 0xAAD60AC7 ; # 2866154183 
    my $crc = adler32($data) ;
    is $crc, $expected_crc;
}

{
    # memGunzip - input > 4K

    my $contents = '' ;
    foreach (1 .. 20000)
      { $contents .= chr int rand 256 }

    ok my $compressed = memGzip(\$contents) ;
    is $gzerrno, 0;

    ok length $compressed > 4096 ;
    ok my $out = memGunzip(\$compressed) ;
    is $gzerrno, 0;
     
    ok $contents eq $out ;
    is length $out, length $contents ;

    
}


{
    # memGunzip Header Corruption Tests

    my $string = <<EOM;
some text
EOM

    my $good ;
    ok my $x = new IO::Compress::Gzip \$good, Append => 1, -HeaderCRC => 1 ;
    ok $x->write($string) ;
    ok  $x->close ;

    {
        title "Header Corruption - Fingerprint wrong 1st byte" ;
        my $buffer = $good ;
        substr($buffer, 0, 1) = 'x' ;

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
    }

    {
        title "Header Corruption - Fingerprint wrong 2nd byte" ;
        my $buffer = $good ;
        substr($buffer, 1, 1) = "\xFF" ;

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
    }

    {
        title "Header Corruption - CM not 8";
        my $buffer = $good ;
        substr($buffer, 2, 1) = 'x' ;

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
    }

    {
        title "Header Corruption - Use of Reserved Flags";
        my $buffer = $good ;
        substr($buffer, 3, 1) = "\xff";

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
    }

}

for my $index ( GZIP_MIN_HEADER_SIZE + 1 ..  GZIP_MIN_HEADER_SIZE + GZIP_FEXTRA_HEADER_SIZE + 1)
{
    title "Header Corruption - Truncated in Extra";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -HeaderCRC => 1, Strict => 0,
				-ExtraField => "hello" x 10  ;
    ok  $x->write($string) ;
    ok  $x->close ;

    substr($truncated, $index) = '' ;

    ok ! memGunzip(\$truncated) ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;


}

my $Name = "fred" ;
for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Name) -1)
{
    title "Header Corruption - Truncated in Name";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok  my $x = new IO::Compress::Gzip \$truncated, Append => 1, -Name => $Name;
    ok  $x->write($string) ;
    ok  $x->close ;

    substr($truncated, $index) = '' ;

    ok ! memGunzip(\$truncated) ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}

my $Comment = "comment" ;
for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + length($Comment) -1)
{
    title "Header Corruption - Truncated in Comment";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok  my $x = new IO::Compress::Gzip \$truncated, -Comment => $Comment;
    ok  $x->write($string) ;
    ok  $x->close ;

    substr($truncated, $index) = '' ;
    ok ! memGunzip(\$truncated) ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}

for my $index ( GZIP_MIN_HEADER_SIZE ..  GZIP_MIN_HEADER_SIZE + GZIP_FHCRC_SIZE -1)
{
    title "Header Corruption - Truncated in CRC";
    my $string = <<EOM;
some text
EOM

    my $truncated ;
    ok  my $x = new IO::Compress::Gzip \$truncated, -HeaderCRC => 1;
    ok  $x->write($string) ;
    ok  $x->close ;

    substr($truncated, $index) = '' ;

    ok ! memGunzip(\$truncated) ;
    cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
}

{
    title "memGunzip can cope with a gzip header with all possible fields";
    my $string = <<EOM;
some text
EOM

    my $buffer ;
    ok  my $x = new IO::Compress::Gzip \$buffer, 
                             -Append     => 1,
                             -Strict     => 0,
                             -HeaderCRC  => 1,
                             -Name       => "Fred",
                             -ExtraField => "Extra",
                             -Comment    => 'Comment';
    ok  $x->write($string) ;
    ok  $x->close ;

    ok defined $buffer ;

    ok my $got = memGunzip($buffer) 
        or diag "gzerrno is $gzerrno" ;
    is $got, $string ;
    is $gzerrno, 0;
}


{
    # Trailer Corruption tests

    my $string = <<EOM;
some text
EOM

    my $good ;
    ok  my $x = new IO::Compress::Gzip \$good, Append => 1 ;
    ok  $x->write($string) ;
    ok  $x->close ;

    foreach my $trim (-8 .. -1)
    {
        my $got = $trim + 8 ;
        title "Trailer Corruption - Trailer truncated to $got bytes" ;
        my $buffer = $good ;

        substr($buffer, $trim) = '';

        ok my $u = memGunzip(\$buffer) ;
        is $gzerrno, 0;
        ok $u eq $string;

    }

    {
        title "Trailer Corruption - Length Wrong, CRC Correct" ;
        my $buffer = $good ;
        substr($buffer, -4, 4) = pack('V', 1234);

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;
    }

    {
        title "Trailer Corruption - Length Wrong, CRC Wrong" ;
        my $buffer = $good ;
        substr($buffer, -4, 4) = pack('V', 1234);
        substr($buffer, -8, 4) = pack('V', 1234);

        ok ! memGunzip(\$buffer) ;
        cmp_ok $gzerrno, "==", Z_DATA_ERROR ;

    }
}


sub slurp
{
    my $name = shift ;

    my $input;
    my $fil = gzopen($name, "rb") ;
    ok $fil , "opened $name";
    cmp_ok $fil->gzread($input, 50000), ">", 0, "read more than zero bytes";
    ok ! $fil->gzclose(), "closed ok";

    return $input;
}

sub trickle
{
    my $name = shift ;

    my $got;
    my $input;
    $fil = gzopen($name, "rb") ;
    ok $fil, "opened ok";
    while ($fil->gzread($input, 50000) > 0)
    {
        $got .= $input;
        $input = '';
    }
    ok ! $fil->gzclose(), "closed ok";

    return $got;

    return $input;
}

{

    title "Append & MultiStream Tests";
    # rt.24041

    my $lex = new LexFile my $name ;
    my $data1 = "the is the first";
    my $data2 = "and this is the second";
    my $trailing = "some trailing data";

    my $fil;

    title "One file";
    $fil = gzopen($name, "wb") ;
    ok $fil, "opened first file"; 
    is $fil->gzwrite($data1), length $data1, "write data1" ;
    ok ! $fil->gzclose(), "Closed";

    is slurp($name), $data1, "got expected data from slurp";
    is trickle($name), $data1, "got expected data from trickle";

    title "Two files";
    $fil = gzopen($name, "ab") ;
    ok $fil, "opened second file"; 
    is $fil->gzwrite($data2), length $data2, "write data2" ;
    ok ! $fil->gzclose(), "Closed";

    is slurp($name), $data1 . $data2, "got expected data from slurp";
    is trickle($name), $data1 . $data2, "got expected data from trickle";

    title "Trailing Data";
    open F, ">>$name";
    print F $trailing;
    close F;

    is slurp($name), $data1 . $data2 . $trailing, "got expected data from slurp" ;
    is trickle($name), $data1 . $data2 . $trailing, "got expected data from trickle" ;
}

{
    title "gzclose & gzflush return codes";
    # rt.29215

    my $lex = new LexFile my $name ;
    my $data1 = "the is some text";
    my $status;

    $fil = gzopen($name, "wb") ;
    ok $fil, "opened first file"; 
    is $fil->gzwrite($data1), length $data1, "write data1" ;
    $status = $fil->gzflush(0xfff);
    ok   $status, "flush not ok" ;
    is $status, Z_STREAM_ERROR;
    ok ! $fil->gzflush(), "flush ok" ;
    ok ! $fil->gzclose(), "Closed";
}
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)