################################################################################
#
# $Project: /Convert-Binary-C $
# $Author: mhx $
# $Date: 2011/04/10 12:32:25 +0200 $
# $Revision: 19 $
# $Source: /tests/233_tags.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 => 148 }
my $c = new Convert::Binary::C;
eval {
$c->parse(<<ENDC);
typedef char string[80];
typedef unsigned char u_8;
struct xxx {
int x, y, z;
};
struct test {
int version;
string type;
u_8 data[20];
struct {
int a;
int b;
int c;
} binary;
struct xxx yyy;
};
ENDC
};
ok($@, '', "Couldn't parse C code");
### first, some basic tag stuff including cloning
$rv = eval { $c->tag('string', 'Format') };
ok($@, '');
ok(not defined $rv);
eval { $c->tag('string', Format => 'String') };
ok($@, '');
$rv = eval { $c->tag('string', 'Format') };
ok($@, '');
ok($rv, 'String');
$rv = eval { $c->tag('string') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'String');
eval { $c->tag('test.data', Format => 'Binary') };
ok($@, '');
$rv = eval { $c->tag('test.data', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('test.data') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
eval { $c->tag('xxx', Format => 'Binary') };
ok($@, '');
$rv = eval { $c->tag('xxx', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('xxx') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
eval { $c->tag('test.binary', Format => 'Binary') };
ok($@, '');
$rv = eval { $c->tag('test.binary', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('test.binary') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
my $d = $c->clone;
$rv = eval { $d->tag('test.binary', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $d->tag('test.binary') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
$rv = eval { $d->tag('string', 'Format') };
ok($@, '');
ok($rv, 'String');
$rv = eval { $d->tag('string') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'String');
$rv = eval { $d->tag('test.data', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $d->tag('test.data') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
$rv = eval { $d->tag('xxx', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $d->tag('xxx') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
eval { $d->tag('test.binary', Format => undef) };
ok($@, '');
$rv = eval { $d->tag('test.binary', 'Format') };
ok($@, '');
ok(not defined $rv);
$rv = eval { $d->tag('test.binary') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 0);
eval { $d->untag('string', 'Format') };
ok($@, '');
$rv = eval { $d->tag('string', 'Format') };
ok($@, '');
ok(not defined $rv);
$rv = eval { $d->tag('string') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 0);
eval { $d->untag('test.data', 'Format') };
ok($@, '');
$rv = eval { $d->tag('test.data', 'Format') };
ok($@, '');
ok(not defined $rv);
$rv = eval { $d->tag('test.data') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 0);
eval { $d->untag('xxx') };
ok($@, '');
$rv = eval { $d->tag('xxx', 'Format') };
ok($@, '');
ok(not defined $rv);
$rv = eval { $d->tag('xxx') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 0);
$rv = eval { $c->tag('test.binary', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('test.binary') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
$rv = eval { $c->tag('string', 'Format') };
ok($@, '');
ok($rv, 'String');
$rv = eval { $c->tag('string') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'String');
$rv = eval { $c->tag('test.data', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('test.data') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
$rv = eval { $c->tag('xxx', 'Format') };
ok($@, '');
ok($rv, 'Binary');
$rv = eval { $c->tag('xxx') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{Format}, 'Binary');
my $sub = sub { @_ };
eval { $c->tag('xxx', 'Hooks', { unpack => $sub, pack => [$sub, 42] }) };
ok($@, '');
$rv = eval { $c->tag('xxx', 'Hooks') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 2);
ok($rv->{unpack}, $sub);
ok(ref $rv->{pack}, 'ARRAY');
ok(@{$rv->{pack}}, 2);
ok($rv->{pack}[0], $sub);
ok($rv->{pack}[1], 42);
$rv = eval { $c->tag('xxx') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 2);
ok($rv->{Format}, 'Binary');
ok(ref $rv->{Hooks}, 'HASH');
eval { $c->tag('xxx', 'Hooks', { pack => undef }) };
ok($@, '');
$rv = eval { $c->tag('xxx', 'Hooks') };
ok($@, '');
ok(ref $rv, 'HASH');
ok(keys %$rv, 1);
ok($rv->{unpack}, $sub);
eval { $c->tag('xxx', 'Hooks', { unpack => undef }) };
ok($@, '');
$rv = eval { $c->tag('xxx', 'Hooks') };
ok($@, '');
ok(not defined $rv);
### test that tagging test.mc.x also tags c.x
$c->clean->parse(<<ENDC);
typedef int a;
typedef enum { FOO } b;
typedef struct { int x; } c;
struct test {
a ma;
b mb;
c mc;
};
ENDC
# also tests tag chaining
eval {
$c->tag('test.ma', Format => 'Binary')
->tag('test.mb', Format => 'Binary')
->tag('test.mc', Format => 'Binary');
};
ok($@, '');
for my $i (qw( a b c )) {
$rv = eval { $c->tag($i, 'Format') };
ok(not defined $rv);
}
eval {
$c->tag('test.mc.x', Format => 'String');
$c->tag('test.mc', Format => undef);
};
ok($@, '');
$rv = eval { $c->tag('test.mc', 'Format') };
ok(not defined $rv);
$rv = eval { $c->tag('test.mc.x', 'Format') };
ok($rv, 'String');
$rv = eval { $c->tag('c.x', 'Format') };
ok($rv, 'String');
### test multiple tags
$c->clean;
eval { $c->tag('int', Format => 'Binary', Hooks => { pack => sub { $_[0] } }, Format => 'String') };
ok($@, '');
$rv = eval { $c->tag('int') };
ok($@, '');
ok(join(',', sort keys %$rv), 'Format,Hooks');
$rv = eval { $c->untag('int') };
ok($@, '');
$rv = eval { $c->tag('int') };
ok($@, '');
ok(join(',', sort keys %$rv), '');
eval { $c->tag('int', Format => 'Binary', Hooks => { pack => sub { $_[0] } }, Format => 'String') };
ok($@, '');
$rv = eval { $c->tag('int') };
ok($@, '');
ok(join(',', sort keys %$rv), 'Format,Hooks');
$rv = eval { $c->untag('int', 'Format') };
ok($@, '');
$rv = eval { $c->tag('int') };
ok($@, '');
ok(join(',', sort keys %$rv), 'Hooks');
$rv = eval { $c->tag('int', Hooks => { pack => undef }) };
ok($@, '');
$rv = eval { $c->tag('int') };
ok($@, '');
ok(join(',', sort keys %$rv), '');