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
|
################################################################################
#
# 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 => 41 }
$SIG{__WARN__} = sub { push @warn, $_[0] };
sub chkwarn {
my $fail = 0;
if( @warn != @_ ) {
print "# wrong number of warnings (got ", scalar @warn,
", expected ", scalar @_, ")\n";
$fail++;
}
for my $ix ( 0 .. $#_ ) {
my $e = $_[$ix];
my $w = $warn[$ix];
unless( $w =~ ref($e) ? $e : qr/\Q$e\E/ ) {
print "# wrong warning, expected $e, got $w\n";
$fail++;
}
}
if( $fail ) { print "# $_" for @warn }
ok( $fail, 0, "warnings check failed" );
@warn = ();
}
$c = Convert::Binary::C->new( ByteOrder => 'BigEndian', IntSize => 4 );
$c->parse("typedef unsigned int u_32;");
$ref = pack "N*", 1000000, 5000000, 3000000, 4000000;
$data = pack "N*", 1000000, 2000000, 3000000, 4000000;
$x = eval { $c->unpack('u_32', $data) };
ok($@, '');
ok($x, 1000000);
chkwarn();
$x = eval { $c->unpack('u_32', substr $data, 0, 4) };
ok($@, '');
ok($x, 1000000);
chkwarn();
$x = eval { $c->unpack('u_32', substr $data, 4) };
ok($@, '');
ok($x, 2000000);
chkwarn();
$x = eval { $c->unpack('u_32', substr $data, 8, 4) };
ok($@, '');
ok($x, 3000000);
chkwarn();
$x = eval { $c->unpack('u_32', substr $data, 8, 3) };
ok($@, '');
ok(not defined $x);
chkwarn(qr/Data too short/);
$x = $data;
eval { substr($x, 4, 4) = $c->pack('u_32', 5000000) };
ok($@, '');
ok($x, $ref);
chkwarn();
$x = eval { $c->pack('u_32', 5000000, substr($data, 4, 4)) };
ok($@, '');
ok($x, pack('N', 5000000));
chkwarn();
$x = $data;
eval { $c->pack('u_32', 5000000, substr($x, 4, 4)) };
ok($@, '');
ok($x, $ref);
chkwarn();
eval { $c->pack('u_32', 5000000, substr('Hello World', 4, 4)) };
ok($@, qr/Modification of a read-only value attempted/);
chkwarn();
$x = $data;
eval { $c->pack('u_32', 5000000, substr($x, 4)) };
ok($@, '');
ok($x, $ref);
chkwarn();
$x = $data;
eval { $c->pack('u_32', 5000000, substr($x, 4, 0)) };
ok($@, '');
ok($x, pack('N*', 1000000, 5000000, 2000000, 3000000, 4000000));
chkwarn();
for my $ix (0 .. 2) {
my $r = eval { $c->unpack('u_32', substr $data, ($ix+1)*$c->sizeof('u_32')) };
ok($@, '');
ok($r, (unpack "N*", $data)[$ix+1]);
chkwarn();
}
|
