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
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
################################################################################
#
# 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;
use Convert::Binary::C @ARGV;
$^W = 1;
BEGIN { plan tests => 8 }
tie @a1, 'Tie::Array::CBCTest';
tie @a2, 'Tie::Array::CBCTest';
tie @a3, 'Tie::Array::CBCTest';
tie @a4, 'Tie::Array::CBCTest';
tie %h1, 'Tie::Hash::CBCTest';
tie %h2, 'Tie::Hash::CBCTest';
tie @a, 'Tie::Array::CBCTest';
tie %h, 'Tie::Hash::CBCTest';
@a1 = ( 1 .. 4 );
@a2 = ( 4, 5 );
@a3 = ( 7, 8 );
%h1 = ( i => 3, c => \@a2 );
%h2 = ( i => 6, c => \@a3 );
@a4 = ( \%h1, \%h2 );
%h = ( foo => 1, bar => 2, baz => \@a1, xxx => \@a4 );
$ref = { foo => 2, bar => 3, baz => [2 .. 5],
xxx => [ { i => 4, c => [5, 6] }, { i => 7, c => [8, 9] } ] };
$c = Convert::Binary::C->new->parse( <<ENDC );
struct tie {
int foo;
int bar;
int baz[4];
struct {
int i;
char c[2];
} xxx[2];
};
ENDC
$p1 = $c->pack('tie', \%h);
$p2 = $c->pack('tie', $ref);
ok( $p1, $p2 );
$p1 = $c->pack('tie.baz', $h{baz});
$p2 = $c->pack('tie.baz', $ref->{baz});
ok( $p1, $p2 );
$p1 = $c->pack('tie.xxx[0]', $h{xxx}[0]);
$p2 = $c->pack('tie.xxx[0]', $ref->{xxx}[0]);
ok( $p1, $p2 );
$i1 = $c->initializer('tie', \%h);
$i2 = $c->initializer('tie', $ref);
ok( $i1, $i2 );
$i1 = $c->initializer('tie.baz', $h{baz});
$i2 = $c->initializer('tie.baz', $ref->{baz});
ok( $i1, $i2 );
$i1 = $c->initializer('tie.xxx[0]', $h{xxx}[0]);
$i2 = $c->initializer('tie.xxx[0]', $ref->{xxx}[0]);
ok( $i1, $i2 );
@a = ('FOO=42');
$c->configure( Define => \@a );
$c->parse( 'typedef char zaphod[FOO];' );
ok( $c->sizeof('zaphod'), 42 );
@a = sort qw( const inline restrict );
$c->configure( DisabledKeywords => \@a );
$b = $c->configure( 'DisabledKeywords' );
ok( "@a", "@$b" );
package Tie::Hash::CBCTest;
sub TIEHASH { bless {}, $_[0] }
sub STORE { $_[0]->{$_[1]} = $_[2] }
sub FETCH { my $x = $_[0]->{$_[1]}; ref $x || $x =~ /\D/ ? $x : $x+1 }
sub FIRSTKEY { my $a = scalar keys %{$_[0]}; each %{$_[0]} }
sub NEXTKEY { each %{$_[0]} }
sub EXISTS { exists $_[0]->{$_[1]} }
sub DELETE { delete $_[0]->{$_[1]} }
sub CLEAR { %{$_[0]} = () }
package Tie::Array::CBCTest;
sub TIEARRAY { bless [], $_[0] }
sub EXTEND { }
sub FETCHSIZE { scalar @{$_[0]} }
sub STORESIZE { $#{$_[0]} = $_[1]-1 }
sub STORE { $_[0]->[$_[1]] = $_[2] }
sub FETCH { my $x = $_[0]->[$_[1]]; ref $x || $x =~ /\D/ ? $x : $x+1 }
sub CLEAR { @{$_[0]} = () }
sub POP { pop(@{$_[0]}) }
sub PUSH { my $o = shift; push(@$o,@_) }
sub SHIFT { shift(@{$_[0]}) }
sub UNSHIFT { my $o = shift; unshift(@$o,@_) }
# sub EXISTS { defined $_[0]->[$_[1]] } # exists doesn't work for < 5.6.0
# sub DELETE { undef $_[0]->[$_[1]] } # delete doesn't work for < 5.6.0
sub SPLICE
{
my $ob = shift;
my $sz = $ob->FETCHSIZE;
my $off = @_ ? shift : 0;
$off += $sz if $off < 0;
my $len = @_ ? shift : $sz-$off;
return splice(@$ob,$off,$len,@_);
}
|
