The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
################################################################################
#
# Copyright (c) 2002-2015 Marcus Holland-Moritz. All rights reserved.
# This program is free software; you can redistribute it and/or modify
# it under the same terms as Perl itself.
#
################################################################################

use Test;
use Convert::Binary::C @ARGV;

$^W = 1;

BEGIN { plan tests => 91 }

eval {
  $C{B} = new Convert::Binary::C LongSize     => 4,
                                 LongLongSize => 8,
                                 ByteOrder    => 'BigEndian';
};
ok($@,'',"failed to create Convert::Binary::C object");

eval {
  $C{B}->parse( <<'ENDC' );
typedef signed long long int   i_64;
typedef unsigned long long int u_64;
typedef signed long int        i_32;
typedef unsigned long int      u_32;
ENDC
};
ok($@,'',"failed to parse code");

eval {
  $C{L} = $C{B}->clone->ByteOrder( 'LittleEndian' );
};
ok($@,'',"failed to clone LittleEndian object");

@bytes = ( 0xAB, 0x54, 0xA9, 0x8C, 0xEB, 0x1F, 0x0A, 0xD2 );
$str{B} = pack 'C*', @bytes;
$str{L} = pack 'C*', reverse @bytes;

%order = (
  B => 'BigEndian',
  L => 'LittleEndian',
);

@tests = (
  {
    type => 'u_64',
    B => "12345678901234567890",
    L => "12345678901234567890",
  },
  {
    type => 'i_64',
    B => "-6101065172474983726",
    L => "-6101065172474983726",
  },
  {
    type => 'u_32',
    B => "2874452364",
    L => "3944680146",
  },
  {
    type => 'i_32',
    B => "-1420514932",
    L => "-350287150",
  },
);

for my $test ( @tests ) {
  for my $bo ( qw( B L ) ) {
    print "# unpack $order{$bo} $test->{type}\n";
    eval { $val = $C{$bo}->unpack( $test->{type}, $str{$bo} ) };
    ok($@,'',"unpack failed");
    ok($val, $test->{$bo}, "wrong value");
  }
}

@tests = (
  {
    type => 'u_64',
    B => " + 12345678901234567890",
    L => "12345678901234567890",
  },
  {
    type => 'i_64',
    B => " -6101065172474983726",
    L => "-  6101065172474983726",
  },
  {
    type => 'u_32',
    B => " + 2874452364",
    L => "3944680146",
  },
  {
    type => 'i_32',
    B => "-  1420514932",
    L => " - 350287150",
  },
);

for my $test ( @tests ) {
  for my $bo ( qw( B L ) ) {
    print "# pack $order{$bo} $test->{type}\n";
    eval { $val = $C{$bo}->pack( $test->{type}, $test->{$bo} ) };
    ok($@,'',"pack failed for $order{$bo} $test->{type} test");
    ok(length($val), $C{$bo}->sizeof($test->{type}), "wrong string size" );
    ok($val, substr($str{$bo}, 0, length($val)), "wrong string");
  }
}

@tests = (
  {
    name => 'dec',
    type => 'u_64',
    str  => pack("C*", 0x01, 0x23, 0x45, 0x67, 0x89, 0xAB, 0xCD, 0x0E),
    B => " 81985529216486670",
    L => "1066697293388129025",
  },
  {
    name => 'hex',
    type => 'u_64',
    str  => pack("C*", 0x01, 0x23, 0x45, 0x67, 0x89, 0xAB, 0xCD, 0x0E),
    B => "0x0123456789aBCd0E",
    L => " 0x0ECdaB8967452301",
  },
  {
    name => 'oct',
    type => 'u_64',
    str  => pack("C*", 0x01, 0x23, 0x45, 0x67, 0x89, 0xAB, 0xCD, 0x0E),
    B => "04432126361152746416",
    L => "  073155270454721221401",
  },
  {
    name => 'bin',
    type => 'u_64',
    str  => pack("C*", 0x01, 0x23, 0x45, 0x67, 0x89, 0xAB, 0xCD, 0x0E),
    B => " 0b100100011010001010110011110001001101010111100110100001110  ",
    L => "0b111011001101101010111000100101100111010001010010001100000001  ",
  },
  {
    name => 'dec',
    type => 'u_32',
    str  => pack("C*", 0x00, 0xaf, 0xfe, 0x00),
    B => "   11533824 ",
    L => "  16690944",
  },
  {
    name => 'hex',
    type => 'u_32',
    str  => pack("C*", 0x00, 0xaf, 0xfe, 0x00),
    B => "  0x00AffE00",
    L => "0x00FeaF00  ",
  },
  {
    name => 'oct',
    type => 'u_32',
    str  => pack("C*", 0x00, 0xaf, 0xfe, 0x00),
    B => "  053777000",
    L => " 077527400  ",
  },
  {
    name => 'bin',
    type => 'u_32',
    str  => pack("C*", 0x00, 0xaf, 0xfe, 0x00),
    B => " 0b101011111111111000000000",
    L => "  0b111111101010111100000000",
  },
);

for my $test ( @tests ) {
  for my $bo ( qw( B L ) ) {
    print "# pack $test->{name} $order{$bo} $test->{type}\n";
    eval { $val = $C{$bo}->pack( $test->{type}, $test->{$bo} ) };
    ok($@,'',"pack failed for $order{$bo} $test->{type} test");
    ok(length($val), $C{$bo}->sizeof($test->{type}), "wrong string size" );
    ok($val, substr($test->{str}, 0, length($val)), "wrong string");
  }
}