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
125
126
127
128
129
130
131
132
133
|
use warnings;
use strict;
use Test::More tests => 1 + 2*21 + 1*17 + 1*17 + 4*21;
BEGIN { use_ok "Data::Integer", qw(
sint_shl uint_shl
sint_shr uint_shr
sint_rol uint_rol
sint_ror uint_ror
uint_bits_as_sint natint_bits min_sint
); }
sub nint_is($$) {
my($tval, $cval) = @_;
my $tval0 = $tval;
ok defined($tval) && ref(\$tval) eq "SCALAR" &&
int($tval0) == $tval0 && "$tval" eq "$cval" &&
((my $tval1 = $tval) <=> 0) == ((my $cval1 = $cval) <=> 0) &&
do { use integer; $tval == $cval },
"$tval match $cval";
}
my $bm1 = min_sint|0;
my $bm2 = $bm1 >> 1;
my $bm3 = $bm2 >> 1;
my $bm4 = $bm3 >> 1;
foreach([ 0, 0, 0 ],
[ 0, 1, 0 ],
[ 0, 16, 0 ],
[ 0, natint_bits-1, 0 ],
[ 1, 0, 1 ],
[ 1, 1, 2 ],
[ 1, 5, 32 ],
[ 1, natint_bits-1, $bm1 ],
[ 2, 0, 2 ],
[ 2, 1, 4 ],
[ 2, 5, 64 ],
[ 2, natint_bits-2, $bm1 ],
[ 2, natint_bits-1, 0 ],
[ 3, 0, 3 ],
[ 3, 1, 6 ],
[ 3, 5, 96 ],
[ 3, natint_bits-1, $bm1 ],
[ 0x123, 0, 0x123 ],
[ 0x123, 4, 0x1230 ],
[ $bm1|0x123, 0, $bm1|0x123 ],
[ $bm1|0x123, 4, 0x1230 ],
) {
my($ua, $dist, $ur) = @$_;
nint_is uint_shl($ua, $dist), $ur;
my($sa, $sr) = (uint_bits_as_sint($ua), uint_bits_as_sint($ur));
nint_is sint_shl($sa, $dist), $sr;
}
foreach([ 0, 1, 0 ],
[ 0, 16, 0 ],
[ 0, natint_bits-1, 0 ],
[ 1, 1, 0 ],
[ 1, 16, 0 ],
[ 1, natint_bits-1, 0 ],
[ 0xa5c0, 1, 0x52e0 ],
[ 0xa5c0, 4, 0xa5c ],
[ 0xa5c0, 8, 0xa5 ],
[ 0xa5c0, 12, 0xa ],
[ 0xa5c0, 16, 0 ],
[ 0xa5c0, natint_bits-1, 0 ],
[ $bm1, 1, $bm2 ],
[ $bm1|6, 1, $bm2|3 ],
[ $bm1, natint_bits-2, 2 ],
[ $bm1|6, natint_bits-2, 2 ],
[ $bm1|6, natint_bits-1, 1 ],
) {
my($ua, $dist, $ur) = @$_;
nint_is uint_shr($ua, $dist), $ur;
}
foreach([ 0, 1, 0 ],
[ 0, 16, 0 ],
[ 0, natint_bits-1, 0 ],
[ 1, 1, 0 ],
[ 1, 16, 0 ],
[ 1, natint_bits-1, 0 ],
[ 0xa5c0, 1, 0x52e0 ],
[ 0xa5c0, 4, 0xa5c ],
[ 0xa5c0, 8, 0xa5 ],
[ 0xa5c0, 12, 0xa ],
[ 0xa5c0, 16, 0 ],
[ 0xa5c0, natint_bits-1, 0 ],
[ uint_bits_as_sint($bm1), 1, uint_bits_as_sint($bm1|$bm2) ],
[ uint_bits_as_sint($bm1|6), 1, uint_bits_as_sint($bm1|$bm2|3) ],
[ uint_bits_as_sint($bm1), natint_bits-2, -2 ],
[ uint_bits_as_sint($bm1|6), natint_bits-2, -2 ],
[ uint_bits_as_sint($bm1|6), natint_bits-1, -1 ],
) {
my($sa, $dist, $sr) = @$_;
nint_is sint_shr($sa, $dist), $sr;
}
foreach([ 0, 0, 0 ],
[ 0, 1, 0 ],
[ 0, 16, 0 ],
[ 0, -1, 0 ],
[ 1, 0, 1 ],
[ 1, 1, 2 ],
[ 1, 5, 32 ],
[ 1, -1, $bm1 ],
[ 2, 0, 2 ],
[ 2, 1, 4 ],
[ 2, 5, 64 ],
[ 2, -1, 1 ],
[ 2, -2, $bm1 ],
[ 2, -3, $bm2 ],
[ 0x123, 4, 0x1230 ],
[ 0x123, -4, 0x12|$bm3|$bm4 ],
[ $bm2|$bm4, 0, $bm2|$bm4 ],
[ $bm2|$bm4, 1, $bm1|$bm3 ],
[ $bm2|$bm4, 2, 1|$bm2 ],
[ $bm2|$bm4, 3, 2|$bm1 ],
[ $bm2|$bm4, 4, 5 ],
) {
my($ua, $dist, $ur) = @$_;
my $ldist = (natint_bits + $dist) % natint_bits;
my $rdist = (natint_bits - $dist) % natint_bits;
nint_is uint_rol($ua, $ldist), $ur;
nint_is uint_ror($ua, $rdist), $ur;
my($sa, $sr) = (uint_bits_as_sint($ua), uint_bits_as_sint($ur));
nint_is sint_rol($sa, $ldist), $sr;
nint_is sint_ror($sa, $rdist), $sr;
}
1;
|
