view release on metacpan or  search on metacpan

t/legacy/10-bson.t  view on Meta::CPAN

use Math::BigInt;
require re;

use BSON qw/encode decode/;

my $a;
tie( my %h, 'Tie::IxHash' );
tie( my %h1, 'Tie::IxHash' );
tie( my %h2, 'Tie::IxHash' );

sub _dump_bson {
    my $bson = unpack("H*",shift);
    $bson =~ s/(..)/$1 /g;
    return $bson;
}

sub _delta_ok {
    my ($lhs, $rhs, $label) = @_;;
    local $Test::Builder::Level = $Test::Builder::Level + 1;
    ok( abs($lhs - $rhs) < 1e-6, $label );
}

# Int32
subtest int32 => sub {
    plan tests => 2;
    %h = ( a => 1, b => 2147483647, c => -2147483648 );
    my $bson = encode( \%h );
    is_deeply(
        [ unpack "C*", $bson ],
        [
            26,  0,   0,   0,   16, 97, 0, 1, 0, 0, 0,   16, 98, 0,
            255, 255, 255, 127, 16, 99, 0, 0, 0, 0, 128, 0
        ],
        'Int32 encode'
    );
    is_deeply( decode($bson), \%h, 'Int32 decode' );
};

# Int64
subtest int64 => sub {
    %h = (
        a => Math::BigInt->new('2147483648'),
        b => Math::BigInt->new('9223372036854775807'),
        c => Math::BigInt->new('-9223372036854775808')
    );
    my $bson = encode( \%h );

    cmp_deeply(
        [ unpack "C*", $bson ],
        [
            38,  0,   0,   0,
            18,  97,  0,   0,   0,   0,   128, 0,   0,   0,   0,
            18,  98,  0,   255, 255, 255, 255, 255, 255, 255, 127,
            18,  99,  0,   0,   0,   0,   0,   0,   0,   0,   128,
            0
        ],
        'Int64 encode'
    );

    # is_deeply fails to compare int64 properly
    my $decoded = decode($bson);
    for my $k ( qw/a b c/ ) {
        is( $decoded->{$k}, $h{$k}, "key $k" );
    }
};

# Mixed ints
subtest mix_ints => sub {
    %h = ( a => Math::BigInt->new('2147483648'), b => 1, c => -20 );
    my $bson = encode( \%h );

    # is_deeply fails to compare int64 properly
    cmp_deeply(
        [ unpack "C*", $bson ],
        [
            30,  0, 0,  0,  18, 97,  0,   0,   0,   0,
            128, 0, 0,  0,  0,  16,  98,  0,   1,   0,
            0,   0, 16, 99, 0,  236, 255, 255, 255, 0
        ],
        'Mixints encode'
    );

    # is_deeply fails to compare int64 properly
    my $decoded = decode($bson);
    for my $k ( qw/a b c/ ) {
        is( $decoded->{$k}, $h{$k}, "key $k" );
    }
};

subtest boolean => sub {
    plan tests => 6;

    # Boolean true
    %h = ( a => BSON::Bool->true );
    my $bson = encode( \%h );
    is_deeply(
        [ unpack "C*", $bson ],
        [ 9, 0, 0, 0, 8, 97, 0, 1, 0 ],
        'True encode'
    );
    is_deeply( decode($bson), \%h, 'True decode' );

    # Boolean false
    %h = ( a => BSON::Bool->false );
    $bson = encode( \%h );
    is_deeply(
        [ unpack "C*", $bson ],
        [ 9, 0, 0, 0, 8, 97, 0, 0, 0 ],
        'False encode'
    );
    is_deeply( decode($bson), \%h, 'False decode' );

    # Boolean mixed
    %h = ( a => BSON::Bool->true, b => BSON::Bool->false );
    $bson = encode( \%h );
    is_deeply(
        [ unpack "C*", $bson ],
        [ 13, 0, 0, 0, 8, 97, 0, 1, 8, 98, 0, 0, 0 ],
        'mixed encode'
    );
    is_deeply( decode($bson), \%h, 'Mixed decode' );
};

# Double
subtest double => sub {
    plan tests => 4;
    %h = ( a => 0.12345, b => -0.1234, c => 123456.789 );
    my $bson = encode( \%h );
    is_deeply(
        [ unpack "C*", $bson ],
        [
            38,  0,   0,   0,   1,   97,  0,  124, 242, 176,
            80,  107, 154, 191, 63,  1,   98, 0,   243, 142,
            83,  116, 36,  151, 191, 191, 1,  99,  0,   201,
            118, 190, 159, 12,  36,  254, 64, 0
        ],
        'Double encode'
    );

    my $hash = decode( $bson );
    for my $k ( sort keys %$hash ) {
        _delta_ok( $hash->{$k}, $h{$k}, "Double decode $h{$k}" );
    }
};

# String