1#!perl -w
2
3use strict;
4use warnings;
5use Test::More;
6use Devel::Peek;
7use Config;
8
9BEGIN { use_ok('XS::APItest') }
10
11my $is_wide = $Config{ivsize} == 8;
12
13sub test_rot {
14    my ( $fnc, $n, $r, $max ) = @_;
15    my %seen;
16    my @seq;
17    while ( @seq < $max and !$seen{$n}++ ) {
18        push @seq, $n;
19        $n = $fnc->( $n, $r );
20    }
21    return \@seq;
22}
23
24for my $test (
25    [
26        # source string:
27        "\x{12}\x{34}\x{56}\x{78}\x{9A}\x{BC}\x{DE}\x{F0}" x 2,
28
29        #results:
30        #16         32              64
31        "0x3412", "0x78563412", "0xf0debc9a78563412",
32        "0x5634", "0x9A785634", "0x12f0debc9a785634",
33        "0x7856", "0xBC9A7856", "0x3412f0debc9a7856",
34        "0x9A78", "0xDEBC9A78", "0x563412f0debc9a78",
35        "0xBC9A", "0xF0DEBC9A", "0x78563412f0debc9a",
36        "0xDEBC", "0x12F0DEBC", "0x9a78563412f0debc",
37        "0xF0DE", "0x3412F0DE", "0xbc9a78563412f0de",
38        "0x12F0", "0x563412F0", "0xdebc9a78563412f0",
39    ],
40    [
41        # source string:
42        "\x{F0}\x{E1}\x{D2}\x{C3}\x{B4}\x{A5}\x{96}\x{87}" x 2,
43
44        #results:
45        #16         32              64
46        "0xe1f0", "0xc3d2e1f0", "0x8796a5b4c3d2e1f0",
47        "0xd2e1", "0xb4c3d2e1", "0xf08796a5b4c3d2e1",
48        "0xc3d2", "0xa5b4c3d2", "0xe1f08796a5b4c3d2",
49        "0xb4c3", "0x96a5b4c3", "0xd2e1f08796a5b4c3",
50        "0xa5b4", "0x8796a5b4", "0xc3d2e1f08796a5b4",
51        "0x96a5", "0xf08796a5", "0xb4c3d2e1f08796a5",
52        "0x8796", "0xe1f08796", "0xa5b4c3d2e1f08796",
53        "0xf087", "0xd2e1f087", "0x96a5b4c3d2e1f087",
54    ],
55  )
56{
57    my $str = $test->[0];
58    for my $ofs ( 0 .. 7 ) {
59        my $n = ( $ofs * 3 ) + 1;
60        my ( $want16, $want32, $want64 ) = @{$test}[ $n .. ( $n + 2 ) ];
61        my $input = join " ", map { sprintf "%02x", ord($_) } split //,
62          substr $str, $ofs, 8;
63        my $hex16 = sprintf "0x%04x",
64          XS::APItest::HvMacro::u8_to_u16_le( $str, $ofs );
65        is( $hex16, lc($want16),
66                "U8TO16_LE works as expected (hex bytes:"
67              . substr( $input, 0, 4 + 1 )
68              . ")" );
69        my $hex32 = sprintf "0x%08x",
70          XS::APItest::HvMacro::u8_to_u32_le( $str, $ofs );
71        is( $hex32, lc($want32),
72                "U8TO32_LE works as expected (hex bytes:"
73              . substr( $input, 0, 8 + 3 )
74              . ")" );
75        next unless $is_wide;
76        my $hex64 = sprintf "0x%016x",
77          XS::APItest::HvMacro::u8_to_u64_le( $str, $ofs );
78        is( $hex64, lc($want64),
79                "U8TO64_LE works as expected (hex bytes:"
80              . substr( $input, 0, 16 + 7 )
81              . ")" );
82    }
83}
84{
85    my $seq_l32 = test_rot( \&XS::APItest::HvMacro::rotl32, 1, 1, 33 );
86    is( 0 + @$seq_l32, 32, "rotl32(n,1) works as expected" );
87    is_deeply(
88        $seq_l32,
89        [
90            1,         2,         4,          8,
91            16,        32,        64,         128,
92            256,       512,       1024,       2048,
93            4096,      8192,      16384,      32768,
94            65536,     131072,    262144,     524288,
95            1048576,   2097152,   4194304,    8388608,
96            16777216,  33554432,  67108864,   134217728,
97            268435456, 536870912, 1073741824, 2147483648
98        ],
99        "rotl32(n,1) returned expected results"
100    );
101    my $seq_r32 = test_rot( \&XS::APItest::HvMacro::rotr32, 1, 1, 33 );
102    is( 0 + @$seq_r32, 32, "rotr32(n,1) works as expected" );
103    is_deeply(
104        $seq_r32,
105        [
106            1,         2147483648, 1073741824, 536870912,
107            268435456, 134217728,  67108864,   33554432,
108            16777216,  8388608,    4194304,    2097152,
109            1048576,   524288,     262144,     131072,
110            65536,     32768,      16384,      8192,
111            4096,      2048,       1024,       512,
112            256,       128,        64,         32,
113            16,        8,          4,          2
114        ],
115        "rotr32(n,1) returned expected"
116    );
117    isnt( "@$seq_l32", "@$seq_r32",
118        "rotl32(n,1) and rotr32(n,1) return different results" );
119}
120if ($is_wide) {
121    my $seq_l64 = test_rot( \&XS::APItest::HvMacro::rotl64, 1, 1, 65 );
122    is( 0 + @$seq_l64, 64, "rotl64(n,1) works as expected" );
123    is_deeply(
124        $seq_l64,
125        [
126            1,                     2,
127            4,                     8,
128            16,                    32,
129            64,                    128,
130            256,                   512,
131            1024,                  2048,
132            4096,                  8192,
133            16384,                 32768,
134            65536,                 131072,
135            262144,                524288,
136            1048576,               2097152,
137            4194304,               8388608,
138            16777216,              33554432,
139            67108864,              134217728,
140            268435456,             536870912,
141            1073741824,            2147483648,
142            4294967296,            8589934592,
143            '17179869184',         '34359738368',
144            '68719476736',         '137438953472',
145            '274877906944',        '549755813888',
146            '1099511627776',       '2199023255552',
147            '4398046511104',       '8796093022208',
148            '17592186044416',      '35184372088832',
149            '70368744177664',      '140737488355328',
150            '281474976710656',     '562949953421312',
151            '1125899906842624',    '2251799813685248',
152            '4503599627370496',    '9007199254740992',
153            '18014398509481984',   '36028797018963968',
154            '72057594037927936',   '144115188075855872',
155            '288230376151711744',  '576460752303423488',
156            '1152921504606846976', '2305843009213693952',
157            '4611686018427387904', '9223372036854775808'
158        ],
159        "rotl64(n,1) returned expected results"
160    );
161    my $seq_r64 = test_rot( \&XS::APItest::HvMacro::rotr64, 1, 1, 65 );
162    is( 0 + @$seq_r64, 64, "rotr64(n,1) works as expected" );
163    is_deeply(
164        $seq_r64,
165        [
166            1,                     '9223372036854775808',
167            '4611686018427387904', '2305843009213693952',
168            '1152921504606846976', '576460752303423488',
169            '288230376151711744',  '144115188075855872',
170            '72057594037927936',   '36028797018963968',
171            '18014398509481984',   '9007199254740992',
172            '4503599627370496',    '2251799813685248',
173            '1125899906842624',    '562949953421312',
174            '281474976710656',     '140737488355328',
175            '70368744177664',      '35184372088832',
176            '17592186044416',      '8796093022208',
177            '4398046511104',       '2199023255552',
178            '1099511627776',       '549755813888',
179            '274877906944',        '137438953472',
180            '68719476736',         '34359738368',
181            '17179869184',         8589934592,
182            4294967296,            2147483648,
183            1073741824,            536870912,
184            268435456,             134217728,
185            67108864,              33554432,
186            16777216,              8388608,
187            4194304,               2097152,
188            1048576,               524288,
189            262144,                131072,
190            65536,                 32768,
191            16384,                 8192,
192            4096,                  2048,
193            1024,                  512,
194            256,                   128,
195            64,                    32,
196            16,                    8,
197            4,                     2
198        ],
199        "rotr64(n,1) returned expected results"
200    );
201    isnt( "@$seq_l64", "@$seq_r64",
202        "rotl64(n,1) and rotr64(n,1) return different results" );
203}
204if ($is_wide) {
205    push @INC, '../../t';
206    require 'charset_tools.pl';
207
208    # The values here are from the ASCII/Unicode code points; so if on EBCDIC
209    # we need # to convert from native to uni to get the same values
210
211    my $seed  = native_to_uni("perl is for good");
212    my $state = XS::APItest::HvMacro::siphash_seed_state($seed);
213    is(
214        sprintf( "%016x",
215            XS::APItest::HvMacro::siphash24( $state, native_to_uni("Larry wall is BDFL")) ),
216        "71a11e065cefc12c",
217        "Siphash24 seems to work"
218    );
219    is(
220        sprintf( "%016x",
221            XS::APItest::HvMacro::siphash13( $state, native_to_uni("Larry wall is BDFL" ))),
222        "adee71f47e49757a",
223        "Siphash13 seems to work"
224    );
225    is( XS::APItest::HvMacro::test_siphash24(), 0, "siphash24 test vectors check" );
226    is( XS::APItest::HvMacro::test_siphash13(), 0, "siphash13 test vectors check" );
227}
228done_testing();
229
230