################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2011/04/10 12:32:21 +0200 $
# $Revision: 33 $
# $Source: /tests/202_misc.t $
#
################################################################################
#
# Copyright (c) 2002-2011 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 => 207 }
#===================================================================
# perform some average stuff
#===================================================================
eval {
$p = new Convert::Binary::C PointerSize => 4,
EnumSize => 4,
IntSize => 4,
LongSize => 4,
Alignment => 2,
ByteOrder => 'BigEndian',
EnumType => 'String';
$q = new Convert::Binary::C;
};
ok($@,'');
#-----------------------------------
# create some average ( ?? :-) code
#-----------------------------------
$code = <<'CCODE';
#define ONLY_ONE 1
typedef struct abc abc_type;
typedef struct never ever;
struct abc {
abc_type *p1;
#if ONLY_ONE > 1
abc_type *p2;
#endif
};
typedef unsigned long u32;
#define Day( which ) \
which ## DAY
typedef enum {
Day( MON ),
Day( TUES ),
Day( WEDNES ),
} day;
# \
define __SIX__ \
( sizeof( unsigned char * ) + sizeof( short ) )
# define SIXTEEN \
(sizeof "Hello\"\xfworld\069!")
typedef union zap {
signed long za[__SIX__];
short zb[SIXTEEN];
char zc[sizeof(struct never (*[2][3])[4])];
ever *zd[sizeof( abc_type )];
} ZAP;
CCODE
#-----------------------
# try to parse the code
#-----------------------
eval {
$p->parse( $code );
$q->parse( $code );
};
ok($@,'');
#------------------------
# reconfigure the parser
#------------------------
eval {
$p->configure( Alignment => 8, EnumSize => 0 );
};
ok($@,'');
#--------------------------------
# and parse some additional code
#--------------------------------
$code = <<'CCODE';
typedef struct {
abc_type xxx;
u32 dusel, *fusel;
int musel[((1<<1)+4)&0x00000002];
union {
char bytes[(12/2)%4][(0x10|010)>>3];
day today;
long value;
} test;
struct ints fubar;
union zap hello;
} husel;
#pragma pack( push, 1 )
struct packer {
char i;
short am;
char really;
long packed;
};
#pragma pack( pop )
struct nopack {
char i;
short am;
char not;
long packed;
};
CCODE
$c99_code = <<'CCODE' . $code;
#define \
MYINTS( ... \
) { int __VA_ARGS__; }
struct ints MYINTS( a, b, c );
CCODE
#-----------------------
# try to parse the code
#-----------------------
eval {
$q->HasMacroVAARGS( 0 );
$q->parse( $c99_code );
};
ok($@,qr/invalid macro argument/);
eval { $p->parse( $c99_code ) };
ok($@,'');
#------------------------
# reconfigure the parser
#------------------------
eval { $p->Alignment( 4 ) };
ok($@,'');
#-------------------
# test some offsets
#-------------------
ok($p->offsetof('packer', 'i'), 0);
ok($p->offsetof('packer', 'am'), 1);
ok($p->offsetof('packer', 'really'), 3);
ok($p->offsetof('packer', 'packed'), 4);
ok($p->offsetof('nopack', 'i'), 0);
ok($p->offsetof('nopack', 'am'), 2);
ok($p->offsetof('nopack', 'not'), 4);
ok($p->offsetof('nopack', 'packed'), 8);
#------------------------
# now try some unpacking
#------------------------
# on a pack()ed struct
$data = pack( 'cnCN', -47, 0x1234, 0x55, 2000000000 );
eval { $result = $p->unpack( 'packer', $data ) };
ok($@,'');
$refres = {
i => -47,
am => 0x1234,
really => 0x55,
packed => 2000000000,
};
reccmp( $refres, $result );
# on a 'normal' struct
$data = pack( 'cxnCx3N', -47, 0x1234, 0x55, 2000000000 );
eval { $result = $p->unpack( 'nopack', $data ) };
ok($@,'');
$refres = {
i => -47,
am => 0x1234,
not => 0x55,
packed => 2000000000,
};
reccmp( $refres, $result );
#-----------------------
# test something bigger
#-----------------------
$data = pack( "N5c8N3C48", 123, 4711, 0xDEADBEEF,
-42, 42, 1, 0, 0, 0, -2, 3, 0, 0,
-10000, 5000, 8000, 1..48 );
eval { $result = $p->unpack( 'husel', $data ) };
ok($@,'');
eval { undef $p };
ok($@,'');
$refres = {
xxx => { p1 => 123 },
dusel => 4711,
fusel => 0xDEADBEEF,
musel => [ -42, 42 ],
test => {
bytes => [ [ 1, 0, 0 ], [ 0, -2, 3 ] ],
today => 'TUESDAY',
value => 16777216,
},
fubar => {
a => -10000,
b => 5000,
c => 8000,
},
hello => {
za => [16909060, 84281096, 151653132, 219025168, 286397204, 353769240],
zb => [258, 772, 1286, 1800, 2314, 2828, 3342, 3856,
4370, 4884, 5398, 5912, 6426, 6940, 7454, 7968],
zc => [1..24],
zd => [16909060, 84281096, 151653132, 219025168],
},
};
reccmp( $refres, $result );
#------------------------------------------------
# test pack/unpack/sizeof/typeof for basic types
#------------------------------------------------
$p = new Convert::Binary::C;
@tests = (
['char', $p->CharSize ],
['short', $p->ShortSize ],
['int', $p->IntSize ],
['long', $p->LongSize ],
['long long', $p->LongLongSize ],
['float', $p->FloatSize ],
['double', $p->DoubleSize ],
['long double', $p->LongDoubleSize],
);
for( @tests ) {
my $size = eval { $p->sizeof( $_->[0] ) };
ok( $@, '' );
ok( $size, $_->[1] );
}
check_basic( $p );
# must work without parse data, too
$p->clean;
check_basic( $p );
#--------------------------------
# test offsetof in strange cases
#--------------------------------
eval {
$p->configure( IntSize => 4
, LongSize => 4
, PointerSize => 4
, EnumSize => 4
, Alignment => 4
)->parse(<<ENDC);
struct foo {
int a;
struct bar {
int x, y;
} ary[5];
struct bar {
int x, y;
} aryary[5][5];
};
typedef int a[10];
typedef struct {
char abc;
long day;
int *ptr;
} week;
struct test {
week zap[8];
};
ENDC
};
@tests = (
['foo', '.ary', 4],
['foo.ary[2]', '.x', 0],
['foo.ary[2]', '.y', 4],
['foo.ary[2]', '', 0],
['foo.ary', '[2].y', 20],
['foo.aryary[2]', '[2].y', 20],
['a', '[9]', 36],
['test', '.zap[5].day', 64],
['test.zap[2]', '.day', 4],
['test', '.zap[5].day+1', 65],
);
$SIG{__WARN__} = sub { push @warn, $_[0] };
ok( $@, '' );
for( @tests ) {
my $off = eval { $p->offsetof( $_->[0], $_->[1] ) };
ok( $@, '' );
ok( $off, $_->[2] );
}
ok( scalar @warn, 1 );
ok( $warn[0], qr/^Empty string passed as member expression/ );
#------------------------------
# some simple tests for member
#------------------------------
@tests = (
['foo', '.ary[0].x', 4],
['foo.ary[2]', '.x', 0],
['foo.ary[2]', '.y', 4],
['foo.ary', '[2].y', 20],
['foo.aryary[2]', '[2].y', 20],
['a', '[9]', 36],
['test', '.zap[5].day', 64],
['test.zap[2]', '.day', 4],
['test', '.zap[5].day+1', 65],
);
@warn = ();
ok( $@, '' );
for( @tests ) {
my @m = eval { $p->member( $_->[0], $_->[2] ) };
ok( $@, '' );
ok( scalar @m, 1 );
ok( $m[0], $_->[1] );
}
ok( scalar @warn, 0 );
#------------------------------
# test 64-bit negative numbers
#------------------------------
$p->clean->parse(<<ENDC);
typedef signed long long i_64;
ENDC
$p->LongLongSize(8);
for my $bo (qw( BigEndian LittleEndian )) {
$p->ByteOrder($bo);
my $x = $p->pack('i_64', -1);
ok($x, pack('C*', (255)x8));
}
sub check_basic
{
my $c = shift;
for my $t ( 'signed char'
, 'unsigned short int'
, 'long int'
, 'signed int'
, 'long long'
)
{
ok( eval { $c->typeof( $t ) }, $t );
ok( eval { $c->sizeof( $t ) } > 0 );
ok( eval { $c->unpack( $t, $c->pack($t, 42) ) }, 42 );
}
}
sub reccmp
{
my($ref, $val) = @_;
my $id = ref $ref;
unless( $id ) {
ok( $ref, $val );
return;
}
if( $id eq 'ARRAY' ) {
ok( @$ref == @$val );
for( 0..$#$ref ) {
reccmp( $ref->[$_], $val->[$_] );
}
}
elsif( $id eq 'HASH' ) {
ok( @{[keys %$ref]} == @{[keys %$val]} );
for( keys %$ref ) {
reccmp( $ref->{$_}, $val->{$_} );
}
}
}