Gecko [ www.blackthorn-inc.com ]

Name	Size	Permission	Date
compress	[ DIR ]	drwxr-xr-x	2015-02-14 16:55
000prereq.t	2.37 KB	-r--r--r--	2014-12-27 11:49
001bzip2.t	5.47 KB	-r--r--r--	2014-12-27 11:48
001zlib-generic-deflate.t	327 B	-r--r--r--	2014-12-27 11:48
001zlib-generic-gzip.t	318 B	-r--r--r--	2014-12-27 11:48
001zlib-generic-rawdeflate.t	342 B	-r--r--r--	2014-12-27 11:48
001zlib-generic-zip.t	313 B	-r--r--r--	2014-12-27 11:48
002any-deflate.t	417 B	-r--r--r--	2014-12-27 11:48
002any-gzip.t	408 B	-r--r--r--	2014-12-27 11:48
002any-rawdeflate.t	431 B	-r--r--r--	2014-12-27 11:48
002any-transparent.t	1.4 KB	-r--r--r--	2014-12-27 11:48
002any-zip.t	403 B	-r--r--r--	2014-12-27 11:48
004gziphdr.t	28.65 KB	-r--r--r--	2014-12-27 11:48
005defhdr.t	9.56 KB	-r--r--r--	2014-12-27 11:48
006zip.t	9.76 KB	-r--r--r--	2014-12-27 11:48
01misc.t	12.13 KB	-r--r--r--	2014-12-27 11:48
020isize.t	4.68 KB	-r--r--r--	2014-12-27 11:49
050interop-gzip.t	2.82 KB	-r--r--r--	2014-12-27 11:48
100generic-bzip2.t	325 B	-r--r--r--	2014-12-27 11:48
100generic-deflate.t	340 B	-r--r--r--	2014-12-27 11:48
100generic-gzip.t	327 B	-r--r--r--	2014-12-27 11:48
100generic-rawdeflate.t	344 B	-r--r--r--	2014-12-27 11:48
100generic-zip.t	315 B	-r--r--r--	2014-12-27 11:48
101truncate-bzip2.t	595 B	-r--r--r--	2014-12-27 11:49
101truncate-deflate.t	601 B	-r--r--r--	2014-12-27 11:49
101truncate-gzip.t	598 B	-r--r--r--	2014-12-27 11:49
101truncate-rawdeflate.t	3.16 KB	-r--r--r--	2014-12-27 11:49
101truncate-zip.t	588 B	-r--r--r--	2014-12-27 11:49
102tied-bzip2.t	322 B	-r--r--r--	2014-12-27 11:48
102tied-deflate.t	326 B	-r--r--r--	2014-12-27 11:48
102tied-gzip.t	317 B	-r--r--r--	2014-12-27 11:48
102tied-rawdeflate.t	341 B	-r--r--r--	2014-12-27 11:48
102tied-zip.t	312 B	-r--r--r--	2014-12-27 11:48
103newtied-bzip2.t	325 B	-r--r--r--	2014-12-27 11:48
103newtied-deflate.t	329 B	-r--r--r--	2014-12-27 11:48
103newtied-gzip.t	320 B	-r--r--r--	2014-12-27 11:48
103newtied-rawdeflate.t	344 B	-r--r--r--	2014-12-27 11:48
103newtied-zip.t	315 B	-r--r--r--	2014-12-27 11:48
104destroy-bzip2.t	325 B	-r--r--r--	2014-12-27 11:48
104destroy-deflate.t	329 B	-r--r--r--	2014-12-27 11:48
104destroy-gzip.t	320 B	-r--r--r--	2014-12-27 11:48
104destroy-rawdeflate.t	344 B	-r--r--r--	2014-12-27 11:48
104destroy-zip.t	315 B	-r--r--r--	2014-12-27 11:48
105oneshot-bzip2.t	326 B	-r--r--r--	2014-12-27 11:48
105oneshot-deflate.t	329 B	-r--r--r--	2014-12-27 11:48
105oneshot-gzip-only.t	3.3 KB	-r--r--r--	2014-12-27 11:48
105oneshot-gzip.t	321 B	-r--r--r--	2014-12-27 11:48
105oneshot-rawdeflate.t	344 B	-r--r--r--	2014-12-27 11:48
105oneshot-zip-bzip2-only.t	4.29 KB	-r--r--r--	2014-12-27 11:48
105oneshot-zip-only.t	6.83 KB	-r--r--r--	2014-12-27 11:48
105oneshot-zip-store-only.t	2.3 KB	-r--r--r--	2014-12-27 11:49
105oneshot-zip.t	315 B	-r--r--r--	2014-12-27 11:48
106prime-bzip2.t	323 B	-r--r--r--	2014-12-27 11:48
106prime-deflate.t	327 B	-r--r--r--	2014-12-27 11:48
106prime-gzip.t	318 B	-r--r--r--	2014-12-27 11:48
106prime-rawdeflate.t	342 B	-r--r--r--	2014-12-27 11:48
106prime-zip.t	313 B	-r--r--r--	2014-12-27 11:48
107multi-bzip2.t	323 B	-r--r--r--	2014-12-27 11:48
107multi-deflate.t	327 B	-r--r--r--	2014-12-27 11:48
107multi-gzip.t	318 B	-r--r--r--	2014-12-27 11:48
107multi-rawdeflate.t	342 B	-r--r--r--	2014-12-27 11:48
107multi-zip.t	313 B	-r--r--r--	2014-12-27 11:48
108anyunc-bzip2.t	422 B	-r--r--r--	2014-12-27 11:48
108anyunc-deflate.t	426 B	-r--r--r--	2014-12-27 11:48
108anyunc-gzip.t	417 B	-r--r--r--	2014-12-27 11:48
108anyunc-rawdeflate.t	441 B	-r--r--r--	2014-12-27 11:48
108anyunc-transparent.t	1.42 KB	-r--r--r--	2014-12-27 11:48
108anyunc-zip.t	408 B	-r--r--r--	2014-12-27 11:48
109merge-deflate.t	327 B	-r--r--r--	2014-12-27 11:48
109merge-gzip.t	318 B	-r--r--r--	2014-12-27 11:48
109merge-rawdeflate.t	342 B	-r--r--r--	2014-12-27 11:48
109merge-zip.t	365 B	-r--r--r--	2014-12-27 11:48
110encode-bzip2.t	324 B	-r--r--r--	2014-12-27 11:48
110encode-deflate.t	330 B	-r--r--r--	2014-12-27 11:48
110encode-gzip.t	319 B	-r--r--r--	2014-12-27 11:48
110encode-rawdeflate.t	345 B	-r--r--r--	2014-12-27 11:48
110encode-zip.t	314 B	-r--r--r--	2014-12-27 11:48
111const-deflate.t	2.39 KB	-r--r--r--	2014-12-27 11:48
999pod.t	261 B	-r--r--r--	2014-12-27 11:48
cz-01version.t	994 B	-r--r--r--	2014-12-27 11:48
cz-03zlib-v1.t	28.5 KB	-r--r--r--	2014-12-27 11:48
cz-06gzsetp.t	3.73 KB	-r--r--r--	2014-12-27 11:48
cz-08encoding.t	3.34 KB	-r--r--r--	2014-12-27 11:48
cz-14gzopen.t	16.02 KB	-r--r--r--	2014-12-27 11:48
globmapper.t	8.13 KB	-r--r--r--	2014-12-27 11:48

Rename

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;

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

plan tests => 595 + $extra ;

use_ok('Compress::Raw::Zlib') ;

use_ok('IO::Compress::Deflate', qw($DeflateError)) ;
    use_ok('IO::Uncompress::Inflate', qw($InflateError)) ;

use_ok('IO::Compress::Zlib::Constants');

}

sub ReadHeaderInfo
{
    my $string = shift || '' ;
    my %opts = @_ ;

my $buffer ;
    ok my $def = new IO::Compress::Deflate \$buffer, %opts ;
    is $def->write($string), length($string), "write" ;
    ok $def->close, "closed" ;
    #print "ReadHeaderInfo\n"; hexDump(\$buffer);

ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1  ;
    my $uncomp = "";
    #ok $inf->read($uncomp) ;
    my $actual = 0 ;
    my $status = 1 ;
    while (($status = $inf->read($uncomp)) > 0) {
        $actual += $status ;
    }

is $actual, length($string) ;
    is $uncomp, $string;
    ok ! $inf->error(), "! error" ;
    ok $inf->eof(), "eof" ;
    ok my $hdr = $inf->getHeaderInfo();
    ok $inf->close ;

return $hdr ;
}

sub ReadHeaderInfoZlib
{
    my $string = shift || '' ;
    my %opts = @_ ;

my $buffer ;
    ok my $def = new Compress::Raw::Zlib::Deflate AppendOutput => 1, %opts ;
    cmp_ok $def->deflate($string, $buffer), '==',  Z_OK;
    cmp_ok $def->flush($buffer), '==', Z_OK;
    #print "ReadHeaderInfoZlib\n"; hexDump(\$buffer);
    
    ok my $inf = new IO::Uncompress::Inflate \$buffer, Append => 1  ;
    my $uncomp ;
    #ok $inf->read($uncomp) ;
    my $actual = 0 ;
    my $status = 1 ;
    while (($status = $inf->read($uncomp)) > 0) {
        $actual += $status ;
    }

is $actual, length($string) ;
    is $uncomp, $string;
    ok ! $inf->error() ;
    ok $inf->eof() ;
    ok my $hdr = $inf->getHeaderInfo();
    ok $inf->close ;

return $hdr ;
}

sub printHeaderInfo
{
    my $buffer = shift ;
    my $inf = new IO::Uncompress::Inflate \$buffer  ;
    my $hdr = $inf->getHeaderInfo();

no warnings 'uninitialized' ;
    while (my ($k, $v) = each %$hdr) {
        print "  $k -> $v\n" ;
    }
}

# Check the Deflate Header Parameters
#========================================

#my $lex = new LexFile my $name ;

{
    title "Check default header settings" ;

my $string = <<EOM;
some text
EOM

my $hdr = ReadHeaderInfo($string);

is $hdr->{CM}, 8, "  CM is 8";
    is $hdr->{FDICT}, 0, "  FDICT is 0";

}

{
    title "Check user-defined header settings match zlib" ;

my $string = <<EOM;
some text
EOM

my @tests = (
        [ {-Level => 0}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
        [ {-Level => 1}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
        [ {-Level => 2}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
        [ {-Level => 3}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
        [ {-Level => 4}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
        [ {-Level => 5}, { FLEVEL => ZLIB_FLG_LEVEL_FAST   } ],
        [ {-Level => 6}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],
        [ {-Level => 7}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
        [ {-Level => 8}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
        [ {-Level => 9}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],

[ {-Level => Z_NO_COMPRESSION  }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
        [ {-Level => Z_BEST_SPEED      }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
        [ {-Level => Z_BEST_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_SLOWEST} ],
        [ {-Level => Z_DEFAULT_COMPRESSION}, { FLEVEL => ZLIB_FLG_LEVEL_DEFAULT} ],

[ {-Strategy => Z_HUFFMAN_ONLY}, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
        [ {-Strategy => Z_HUFFMAN_ONLY,
           -Level    => 3             }, { FLEVEL => ZLIB_FLG_LEVEL_FASTEST} ],
    );

foreach my $test (@tests)
    {
        my $opts = $test->[0] ;
        my $expect = $test->[1] ;

my @title ;
        while (my ($k, $v) = each %$opts)
        {
            push @title, "$k => $v";
        }
        title " Set @title";

my $hdr = ReadHeaderInfo($string, %$opts);

my $hdr1 = ReadHeaderInfoZlib($string, %$opts);

is $hdr->{CM},     8, "  CM is 8";
        is $hdr->{CINFO},  7, "  CINFO is 7";
        is $hdr->{FDICT},  0, "  FDICT is 0";

while (my ($k, $v) = each %$expect)
        {
            if (ZLIB_VERNUM >= 0x1220)
              { is $hdr->{$k}, $v, "  $k is $v" }
            else
              { ok 1, "  Skip test for $k" }
        }

is $hdr->{CM},     $hdr1->{CM},     "  CM matches";
        is $hdr->{CINFO},  $hdr1->{CINFO},  "  CINFO matches";
        is $hdr->{FDICT},  $hdr1->{FDICT},  "  FDICT matches";
        is $hdr->{FLEVEL}, $hdr1->{FLEVEL}, "  FLEVEL matches";
        is $hdr->{FCHECK}, $hdr1->{FCHECK}, "  FCHECK matches";
    }

}

{
    title "No compressed data at all";

my $hdr = ReadHeaderInfo("");

is $hdr->{CM}, 8, "  CM is 8";
    is $hdr->{FDICT}, 0, "  FDICT is 0";

ok defined $hdr->{ADLER32}, "  ADLER32 is defined" ;
    is $hdr->{ADLER32}, 1, "  ADLER32 is 1";
}

{
    # Header Corruption Tests

my $string = <<EOM;
some text
EOM

my $good ;
    ok my $x = new IO::Compress::Deflate \$good ;
    ok $x->write($string) ;
    ok $x->close ;

{
        title "Header Corruption - FCHECK failure - 1st byte wrong";
        my $buffer = $good ;
        substr($buffer, 0, 1) = "\x00" ;

ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
        like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
            "CRC mismatch";
    }

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

ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
        like $IO::Uncompress::Inflate::InflateError, '/Header Error: CRC mismatch/',
            "CRC mismatch";
    }

sub mkZlibHdr
    {
        my $method = shift ;
        my $cinfo  = shift ;
        my $fdict  = shift ;
        my $level  = shift ;

my $cmf  = ($method & 0x0F) ;
           $cmf |= (($cinfo  & 0x0F) << 4) ;
        my $flg  = (($level & 0x03) << 6) ;
           $flg |= (($fdict & 0x01) << 5) ;
        my $fcheck = 31 - ($cmf * 256 + $flg) % 31 ;
        $flg |= $fcheck ;
        #print "check $fcheck\n";

return pack("CC", $cmf, $flg) ;
    }

{
        title "Header Corruption - CM not 8";
        my $buffer = $good ;
        my $header = mkZlibHdr(3, 6, 0, 3);

substr($buffer, 0, 2) = $header;

my $un = new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
        ok ! new IO::Uncompress::Inflate \$buffer, -Transparent => 0  ;
        like $IO::Uncompress::Inflate::InflateError, '/Header Error: Not Deflate $CM is 3$/',
            "  Not Deflate";
    }

}

{
    # Trailer Corruption tests

my $string = <<EOM;
some text
EOM

$string = $string x 1000;
    my $good ;
    ok my $x = new IO::Compress::Deflate \$good ;
    ok $x->write($string) ;
    ok $x->close ;

foreach my $trim (-4 .. -1)
    {
        my $got = $trim + 4 ;
        foreach my $s (0, 1)
        {
            title "Trailer Corruption - Trailer truncated to $got bytes, strict $s" ;
		my $lex = new LexFile my $name ;
            my $buffer = $good ;
            my $expected_trailing = substr($good, -4, 4) ;
            substr($expected_trailing, $trim) = '';

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

ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => $s;
            my $uncomp ;
            if ($s)
            {
                my $status ;
                1 while ($status = $gunz->read($uncomp)) > 0;
                cmp_ok $status, "<", 0 ;
                like $IO::Uncompress::Inflate::InflateError,"/Trailer Error: trailer truncated. Expected 4 bytes, got $got/",
                    "Trailer Error";
            }
            else
            {
                1 while $gunz->read($uncomp) > 0;
                is $uncomp, $string ;
            }
            ok $gunz->eof() ;
            ok $uncomp eq $string;
            ok $gunz->close ;
        }

}

{
        title "Trailer Corruption - CRC Wrong, strict" ;
        my $buffer = $good ;
        my $crc = unpack("N", substr($buffer, -4, 4));
        substr($buffer, -4, 4) = pack('N', $crc+1);
		my $lex = new LexFile my $name ;
        writeFile($name, $buffer) ;

ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 1;
        my $uncomp ;
        my $status ;
        1 while ($status = $gunz->read($uncomp)) > 0;
        cmp_ok $status, "<", 0 ;
        like $IO::Uncompress::Inflate::InflateError,'/Trailer Error: CRC mismatch/',
            "Trailer Error: CRC mismatch";
        ok $gunz->eof() ;
        ok ! $gunz->trailingData() ;
        ok $uncomp eq $string;
        ok $gunz->close ;
    }

{
        title "Trailer Corruption - CRC Wrong, no strict" ;
        my $buffer = $good ;
        my $crc = unpack("N", substr($buffer, -4, 4));
        substr($buffer, -4, 4) = pack('N', $crc+1);
		my $lex = new LexFile my $name ;
        writeFile($name, $buffer) ;

ok my $gunz = new IO::Uncompress::Inflate $name, Append => 1, Strict => 0;
        my $uncomp ;
        my $status ;
        1 while ($status = $gunz->read($uncomp)) > 0;
        cmp_ok $status, '>=', 0  ;
        ok $gunz->eof() ;
        ok ! $gunz->trailingData() ;
        ok $uncomp eq $string;
        ok $gunz->close ;
    }
}