The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
BEGIN {
    if (env::var('PERL_CORE')) {
	chdir 't' if -d 't';
	$^INCLUDE_PATH = @("../lib", "lib/compress");
    }
}

use lib < qw(t t/compress);

use warnings;
use bytes;

use IO::Compress::Base::Common;

use Test::More ; 
use CompTestUtils;

BEGIN {
    # use Test::NoWarnings, if available
    my $extra = 0 ;
    $extra = 1
        if try { require Test::NoWarnings ;  Test::NoWarnings->import(); 1 };

    plan tests => 77 + $extra ;

    use_ok('Scalar::Util');
}


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()
{
    try { ParseParameters(1, \%(), 1) ; };
    like $^EVAL_ERROR->{?description}, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

    try { ParseParameters(1, \%(), undef) ; };
    like $^EVAL_ERROR->{?description}, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

    try { ParseParameters(1, \%(), \@()) ; };
    like $^EVAL_ERROR->{?description}, mkErr(': Expected even number of parameters, got 1'), 
            "Trap odd number of params";

    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_boolean, 0)), Fred => 'joe') ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' must be an int, got 'joe'"), 
            "wanted unsigned, got undef";

    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_unsigned, 0)), Fred => undef) ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' must be an unsigned int, got 'undef'"), 
            "wanted unsigned, got undef";

    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_signed, 0)), Fred => undef) ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' must be a signed int, got 'undef'"), 
            "wanted signed, got undef";

    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_signed, 0)), Fred => 'abc') ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' must be a signed int, got 'abc'"), 
            "wanted signed, got 'abc'";


  SKIP:
    do {
        use Config;

        try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_writable_scalar, 0)), Fred => 'abc') ; };
        like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' not writable"), 
                "wanted writable, got readonly";
    };

    my @xx;
    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_writable_scalar, 0)), Fred => \@xx) ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' not a scalar reference"), 
            "wanted scalar reference";

    local *ABC;
    try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_writable_scalar, 0)), Fred => \*ABC) ; };
    like $^EVAL_ERROR->{?description}, mkErr("Parameter 'Fred' not a scalar"), 
            "wanted scalar";

    #try { ParseParameters(1, \%('Fred' => \@(1, 1, Parse_any|Parse_multiple, 0)), Fred => 1, Fred => 2) ; };
    #like $@, mkErr("Muliple instances of 'Fred' found"),
        #"wanted scalar";

    ok 1;

    my $got = ParseParameters(1, \%('Fred' => \@(1, 1, 0x1000000, 0)), Fred => 'abc') ;
    is $got->value('Fred'), "abc", "other" ;

    $got = ParseParameters(1, \%('Fred' => \@(0, 1, Parse_any, undef)), Fred =>
undef) ;
    ok $got->parsed('Fred'), "undef" ;
    ok ! defined $got->value('Fred'), "undef" ;

    $got = ParseParameters(1, \%('Fred' => \@(0, 1, Parse_string, undef)), Fred =>
undef) ;
    ok $got->parsed('Fred'), "undef" ;
    is $got->value('Fred'), "", "empty string" ;

    my $xx;
    $got = ParseParameters(1, \%('Fred' => \@(1, 1, Parse_writable_scalar, undef)), Fred => $xx) ;

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

    $got = ParseParameters(1, \%('Fred' => \@(1, 1, Parse_writable_scalar, undef)), Fred => \$xx) ;

    ok $got->parsed('Fred'), "parsed" ;
    $xx_ref = $got->value('Fred');
    $$xx_ref = 666 ;
    is $xx, 666;

}

My::testParseParameters();


do {
    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";
};

do {
    title "whatIsInput" ;

    my $lex = LexFile->new( my $out_file) ;
    open my $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";

};

do {
    title "whatIsOutput" ;

    my $lex = LexFile->new( my $out_file) ;
    open my $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

do {
    title "U64" ;

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

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

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

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

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

    title "U64 - add" ;

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

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

    $x = U64->new(0, 0xFFFFFFFE);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFE, "  getLow is 0xFFFFFFFE";

    $x->add(1);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 0xFFFFFFFF, "  getLow is 0xFFFFFFFF";

    $x->add(1);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 0, "  getLow is 0";

    $x->add(1);
    is $x->getHigh, 1, "  getHigh is 1";
    is $x->getLow, 1, "  getLow is 1";

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

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

    title "U64 - equal" ;

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

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

    my $z = U64->new(0, 2);
    is $x->getHigh, 0, "  getHigh is 0";
    is $x->getLow, 1, "  getLow is 1";

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

    title "U64 - pack_V" ;
};