1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
|
################################################################################
#
# Copyright (c) 2002-2024 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::More tests => 11;
use Convert::Binary::C @ARGV;
my $code = <<ENDC;
struct test {
unsigned a:2;
unsigned b:2;
unsigned c:28;
};
ENDC
my $c1 = Convert::Binary::C->new(ByteOrder => 'LittleEndian');
eval {
$c1->parse($code);
$c1->ByteOrder('BigEndian');
};
is($@, '', 'parse/configure');
my $c2 = Convert::Binary::C->new(ByteOrder => 'LittleEndian');
eval {
$c2->ByteOrder('BigEndian');
$c2->parse($code);
};
is($@, '', 'configure/parse');
my $data = pack "N", 0x60000003;
for my $c ($c1, $c2) {
my $t = $c->unpack('test', $data);
is($t->{a}, 1, 'a');
is($t->{b}, 2, 'b');
is($t->{c}, 3, 'c');
}
### Ooops, the hash/list iterators were not reentrant...
$c1->clean->parse(<<'ENDC');
struct hash
{
struct hash *a;
struct hash *b;
};
ENDC
$c1->tag('hash', Hooks => { unpack_ptr => [\&unpack_hash, $c1->arg(qw(SELF TYPE DATA))] });
{
my $i;
sub unpack_hash
{
my($self, $type, $ptr) = @_;
++$i < 3 ? $self->unpack($type, $self->pack($type, { a => $i, b => 10 + $i })) : $ptr;
}
}
{
my @warn;
local $SIG{__WARN__} = sub { push @warn, @_ };
my $dummy = $c1->unpack('hash', $c1->pack('hash', { a => 0, b => 10 }));
is(scalar @warn, 0, 'hash/list iterator reentrancy');
### An assertion in hook_call() could fail if a hook was called
### for a member that didn't actually exist in the hash.
@warn = ();
$dummy = $c1->unpack('hash', $c1->pack('hash', { a => 0 }));
is(scalar @warn, 0, 'hook_call assertion failed');
}
$c1->clean->parse(<<'ENDC');
typedef int foo_t;
ENDC
$c1->tag('foo_t', Hooks => { unpack => \&foo });
is($c1->unpack('foo_t', $c1->pack('foo_t', 42)), 42, 'unpack with moved stack');
sub blow_stack
{
return (1) x 2000;
}
sub foo
{
my @a = blow_stack();
$_[0];
}
|
