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 => 163 + $extra ;

use_ok('Scalar::Util');
    use_ok('IO::Compress::Base::Common');
}

ok gotScalarUtilXS(), "Got XS Version of Scalar::Util"
    or diag <<EOM;
You don't have the XS version of Scalar::Util
EOM

# Compress::Zlib::Common;

sub My::testParseParameters()
{
    eval { ParseParameters(1, {}, 1) ; };
    like $@, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

eval { ParseParameters(1, {}, undef) ; };
    like $@, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

eval { ParseParameters(1, {}, []) ; };
    like $@, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

eval { ParseParameters(1, {'fred' => [Parse_boolean, 0]}, fred => 'joe') ; };
    like $@, mkErr("Parameter 'fred' must be an int, got 'joe'"), 
            "wanted unsigned, got undef";

eval { ParseParameters(1, {'fred' => [Parse_unsigned, 0]}, fred => undef) ; };
    like $@, mkErr("Parameter 'fred' must be an unsigned int, got 'undef'"), 
            "wanted unsigned, got undef";

eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => undef) ; };
    like $@, mkErr("Parameter 'fred' must be a signed int, got 'undef'"), 
            "wanted signed, got undef";

eval { ParseParameters(1, {'fred' => [Parse_signed, 0]}, fred => 'abc') ; };
    like $@, mkErr("Parameter 'fred' must be a signed int, got 'abc'"), 
            "wanted signed, got 'abc'";

eval { ParseParameters(1, {'fred' => [Parse_code, undef]}, fred => 'abc') ; };
    like $@, mkErr("Parameter 'fred' must be a code reference, got 'abc'"), 
            "wanted code, got 'abc'";

SKIP:
    {
        use Config;

skip 'readonly + threads', 2
            if $Config{useithreads};

eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => 'abc') ; };
        like $@, mkErr("Parameter 'fred' not writable"), 
                "wanted writable, got readonly";

skip '\\ returns mutable value in 5.19.3', 1 
            if $] >= 5.019003;

eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \'abc') ; };
        like $@, mkErr("Parameter 'fred' not writable"), 
                "wanted writable, got readonly";
    }

my @xx;
    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => \@xx) ; };
    like $@, mkErr("Parameter 'fred' not a scalar reference"), 
            "wanted scalar reference";

local *ABC;
    eval { ParseParameters(1, {'fred' => [Parse_writable_scalar, 0]}, fred => *ABC) ; };
    like $@, mkErr("Parameter 'fred' not a scalar"), 
            "wanted scalar";

eval { ParseParameters(1, {'fred' => [Parse_any, 0]}, fred => 1, fred => 2) ; };
    like $@, mkErr("Muliple instances of 'fred' found"),
        "multiple instances";

#    my $g = ParseParameters(1, {'fred' => [Parse_unsigned|Parse_multiple, 7]}, fred => 1, fred => 2) ;
#    is_deeply $g->value('fred'), [ 1, 2 ] ;
    ok 1;

#ok 1;

my $got = ParseParameters(1, {'fred' => [0x1000000, 0]}, fred => 'abc') ;
    is $got->getValue('fred'), "abc", "other" ;

$got = ParseParameters(1, {'fred' => [Parse_any, undef]}, fred => undef) ;
    ok $got->parsed('fred'), "undef" ;
    ok ! defined $got->getValue('fred'), "undef" ;

$got = ParseParameters(1, {'fred' => [Parse_string, undef]}, fred => undef) ;
    ok $got->parsed('fred'), "undef" ;
    is $got->getValue('fred'), "", "empty string" ;

my $xx;
    $got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => $xx) ;

ok $got->parsed('fred'), "parsed" ;
    my $xx_ref = $got->getValue('fred');
    $$xx_ref = 77 ;
    is $xx, 77;

$got = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, fred => \$xx) ;

ok $got->parsed('fred'), "parsed" ;
    $xx_ref = $got->getValue('fred');

$$xx_ref = 666 ;
    is $xx, 666;

{
        my $got1 = ParseParameters(1, {'fred' => [Parse_writable_scalar, undef]}, $got) ;
        is $got1, $got, "Same object";
    
        ok $got1->parsed('fred'), "parsed" ;
        $xx_ref = $got1->getValue('fred');
        
        $$xx_ref = 777 ;
        is $xx, 777;
    }

for my $type (Parse_unsigned, Parse_signed, Parse_any)    
    {
        my $value = 0;
        my $got1 ;
        eval { $got1 = ParseParameters(1, {'fred' => [$type, 1]}, fred => $value) } ;
    
        ok ! $@;
        ok $got1->parsed('fred'), "parsed ok" ;
        is $got1->getValue('fred'), 0;
    }

{
        # setValue/getValue
        my $value = 0;
        my $got1 ;
        eval { $got1 = ParseParameters(1, {'fred' => [Parse_any, 1]}, fred => $value) } ;
    
        ok ! $@;
        ok $got1->parsed('fred'), "parsed ok" ;
        is $got1->getValue('fred'), 0;
        $got1->setValue('fred' => undef);
        is $got1->getValue('fred'), undef;        
    }  
    
    {
        # twice
        my $value = 0;
        
        my $got = IO::Compress::Base::Parameters::new();

ok $got->parse({'fred' => [Parse_any, 1]}, fred => $value) ;

ok $got->parsed('fred'), "parsed ok" ;
        is $got->getValue('fred'), 0;
        
        ok $got->parse({'fred' => [Parse_any, 1]}, fred => undef) ;  
        ok $got->parsed('fred'), "parsed ok" ;
        is $got->getValue('fred'), undef;   
        
        ok $got->parse({'fred' => [Parse_any, 1]}, fred => 7) ;  
        ok $got->parsed('fred'), "parsed ok" ;
        is $got->getValue('fred'), 7;   
    }      
}

My::testParseParameters();

{
    title "isaFilename" ;
    ok   isaFilename("abc"), "'abc' isaFilename";

ok ! isaFilename(undef), "undef ! isaFilename";
    ok ! isaFilename([]),    "[] ! isaFilename";
    $main::X = 1; $main::X = $main::X ;
    ok ! isaFilename(*X),    "glob ! isaFilename";
}

{
    title "whatIsInput" ;

my $lex = new LexFile my $out_file ;
    open FH, ">$out_file" ;
    is whatIsInput(*FH), 'handle', "Match filehandle" ;
    close FH ;

my $stdin = '-';
    is whatIsInput($stdin),       'handle',   "Match '-' as stdin";
    #is $stdin,                    \*STDIN,    "'-' changed to *STDIN";
    #isa_ok $stdin,                'IO::File',    "'-' changed to IO::File";
    is whatIsInput("abc"),        'filename', "Match filename";
    is whatIsInput(\"abc"),       'buffer',   "Match buffer";
    is whatIsInput(sub { 1 }, 1), 'code',     "Match code";
    is whatIsInput(sub { 1 }),    ''   ,      "Don't match code";

}

{
    title "whatIsOutput" ;

my $lex = new LexFile my $out_file ;
    open FH, ">$out_file" ;
    is whatIsOutput(*FH), 'handle', "Match filehandle" ;
    close FH ;

my $stdout = '-';
    is whatIsOutput($stdout),     'handle',   "Match '-' as stdout";
    #is $stdout,                   \*STDOUT,   "'-' changed to *STDOUT";
    #isa_ok $stdout,               'IO::File',    "'-' changed to IO::File";
    is whatIsOutput("abc"),        'filename', "Match filename";
    is whatIsOutput(\"abc"),       'buffer',   "Match buffer";
    is whatIsOutput(sub { 1 }, 1), 'code',     "Match code";
    is whatIsOutput(sub { 1 }),    ''   ,      "Don't match code";

}

# U64

{
    title "U64" ;

my $x = new U64();
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0, "  getLow is 0";
    ok ! $x->is64bit(), " ! is64bit";

$x = new U64(1,2);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 2, "  getLow is 2";
    ok $x->is64bit(), " is64bit";

$x = new U64(0xFFFFFFFF,2);
    is $x->getHigh, 0xFFFFFFFF, "  getHigh is 0xFFFFFFFF";
    is $x->getLow, 2, "  getLow is 2";
    ok $x->is64bit(), " is64bit";

$x = new U64(7, 0xFFFFFFFF);
    is $x->getHigh, 7, "  getHigh is 7";
    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
    ok $x->is64bit(), " is64bit";

$x = new U64(666);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 666, "  getLow is 666";
    ok ! $x->is64bit(), " ! is64bit";

title "U64 - add" ;

$x = new U64(0, 1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 1, "  getLow is 1";
    ok ! $x->is64bit(), " ! is64bit";

$x->add(1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 2, "  getLow is 2";
    ok ! $x->is64bit(), " ! is64bit";

$x = new U64(0, 0xFFFFFFFE);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFE, "  getLow is 0xFFFFFFFE";
    is $x->get32bit(),  0xFFFFFFFE, "  get32bit is 0xFFFFFFFE";
    is $x->get64bit(),  0xFFFFFFFE, "  get64bit is 0xFFFFFFFE";
    ok ! $x->is64bit(), " ! is64bit";

$x->add(1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
    is $x->get32bit(),  0xFFFFFFFF, "  get32bit is 0xFFFFFFFF";
    is $x->get64bit(),  0xFFFFFFFF, "  get64bit is 0xFFFFFFFF";
    ok ! $x->is64bit(), " ! is64bit";

$x->add(1);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 0, "  getLow is 0";
    is $x->get32bit(),  0x0, "  get32bit is 0x0";
    is $x->get64bit(), 0xFFFFFFFF+1, "  get64bit is 0x100000000";
    ok $x->is64bit(), " is64bit";

$x->add(1);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 1, "  getLow is 1";
    is $x->get32bit(),  0x1, "  get32bit is 0x1";
    is $x->get64bit(),  0xFFFFFFFF+2, "  get64bit is 0x100000001";
    ok $x->is64bit(), " is64bit";

$x->add(1);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 2, "  getLow is 1";
    is $x->get32bit(),  0x2, "  get32bit is 0x2";
    is $x->get64bit(),  0xFFFFFFFF+3, "  get64bit is 0x100000002";
    ok $x->is64bit(), " is64bit";

$x = new U64(1, 0xFFFFFFFE);
    my $y = new U64(2, 3);

$x->add($y);
    is $x->getHigh, 4, "  getHigh is 4";
    is $x->getLow, 1, "  getLow is 1";
    ok $x->is64bit(), " is64bit";

title "U64 - subtract" ;

$x = new U64(0, 1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 1, "  getLow is 1";
    ok ! $x->is64bit(), " ! is64bit";

$x->subtract(1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0, "  getLow is 0";
    ok ! $x->is64bit(), " ! is64bit";

$x = new U64(1, 0);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 0, "  getLow is 0";
    is $x->get32bit(),  0, "  get32bit is 0xFFFFFFFE";
    is $x->get64bit(),  0xFFFFFFFF+1, "  get64bit is 0x100000000";
    ok $x->is64bit(), " is64bit";

$x->subtract(1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";
    is $x->get32bit(),  0xFFFFFFFF, "  get32bit is 0xFFFFFFFF";
    is $x->get64bit(),  0xFFFFFFFF, "  get64bit is 0xFFFFFFFF";
    ok ! $x->is64bit(), " ! is64bit";

$x = new U64(2, 2);
    $y = new U64(1, 3);

$x->subtract($y);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFF, "  getLow is 1";
    ok ! $x->is64bit(), " ! is64bit";

$x = new U64(0x01CADCE2, 0x4E815983);
    $y = new U64(0x19DB1DE, 0xD53E8000); # NTFS to Unix time delta

$x->subtract($y);
    is $x->getHigh, 0x2D2B03, "  getHigh is 2D2B03";
    is $x->getLow, 0x7942D983, "  getLow is 7942D983";
    ok $x->is64bit(), " is64bit";

title "U64 - equal" ;

$x = new U64(0, 1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 1, "  getLow is 1";
    ok ! $x->is64bit(), " ! is64bit";

$y = new U64(0, 1);
    is $y->getHigh, 0, "  getHigh is 0";
    is $y->getLow, 1, "  getLow is 1";
    ok ! $y->is64bit(), " ! is64bit";

my $z = new U64(0, 2);
    is $z->getHigh, 0, "  getHigh is 0";
    is $z->getLow, 2, "  getLow is 2";
    ok ! $z->is64bit(), " ! is64bit";

ok $x->equal($y), "  equal";
    ok !$x->equal($z), "  ! equal";

title "U64 - clone" ;
    $x = new U64(21, 77);
    $z =  U64::clone($x);
    is $z->getHigh, 21, "  getHigh is 21";
    is $z->getLow, 77, "  getLow is 77";

title "U64 - cmp.gt" ;
    $x = new U64 1;
    $y = new U64 0;
    cmp_ok $x->cmp($y), '>', 0, "  cmp > 0";
    is $x->gt($y), 1, "  gt";
    cmp_ok $y->cmp($x), '<', 0, "  cmp < 0";

}