1#!./perl
2
3use strict;
4use warnings;
5use Config; # to determine nvsize
6use Test::More tests => 23;
7use List::Util qw( uniqnum );
8
9is_deeply( [ uniqnum qw( 1 1.0 1E0 2 3 ) ],
10           [ 1, 2, 3 ],
11           'uniqnum compares numbers' );
12
13is_deeply( [ uniqnum qw( 1 1.1 1.2 1.3 ) ],
14           [ 1, 1.1, 1.2, 1.3 ],
15           'uniqnum distinguishes floats' );
16
17{
18    my @nums = map $_+0.1, 1e7..1e7+5;
19    is_deeply( [ uniqnum @nums ],
20               [ @nums ],
21               'uniqnum distinguishes large floats' );
22
23    my @strings = map "$_", @nums;
24    is_deeply( [ uniqnum @strings ],
25               [ @strings ],
26               'uniqnum distinguishes large floats (stringified)' );
27}
28
29my ($uniq_count1, $uniq_count2, $equiv);
30
31if($Config{nvsize} == 8) {
32  # NV is either 'double' or 8-byte 'long double'
33
34  # The 2 values should be unequal - but just in case perl is buggy:
35  $equiv = 1 if 1.4142135623730951 == 1.4142135623730954;
36
37  $uniq_count1 = uniqnum (1.4142135623730951,
38                          1.4142135623730954 );
39
40  $uniq_count2 = uniqnum('1.4142135623730951',
41                         '1.4142135623730954' );
42}
43
44elsif(length(sqrt(2)) > 25) {
45  # NV is either IEEE 'long double' or '__float128' or doubledouble
46
47  if(1 + (2 ** -1074) != 1) {
48    # NV is doubledouble
49
50    # The 2 values should be unequal - but just in case perl is buggy:
51    $equiv = 1 if 1 + (2 ** -1074) == 1 + (2 ** - 1073);
52
53    $uniq_count1 = uniqnum (1 + (2 ** -1074),
54                            1 + (2 ** -1073) );
55    # The 2 values should be unequal - but just in case perl is buggy:
56    $equiv = 1 if 4.0564819207303340847894502572035e31 == 4.0564819207303340847894502572034e31;
57
58    $uniq_count2 = uniqnum('4.0564819207303340847894502572035e31',
59                           '4.0564819207303340847894502572034e31' );
60  }
61
62  else {
63    # NV is either IEEE 'long double' or '__float128'
64
65    # The 2 values should be unequal - but just in case perl is buggy:
66    $equiv = 1 if 1005.10228292019306452029161597769015 == 1005.1022829201930645202916159776901;
67
68    $uniq_count1 = uniqnum (1005.10228292019306452029161597769015,
69                            1005.1022829201930645202916159776901 );
70
71    $uniq_count2 = uniqnum('1005.10228292019306452029161597769015',
72                           '1005.1022829201930645202916159776901' );
73  }
74}
75
76else {
77  # NV is extended precision 'long double'
78
79  # The 2 values should be unequal - but just in case perl is buggy:
80  $equiv = 1 if 10.770329614269008063 == 10.7703296142690080625;
81
82  $uniq_count1 = uniqnum (10.770329614269008063,
83                          10.7703296142690080625 );
84
85  $uniq_count2 = uniqnum('10.770329614269008063',
86                         '10.7703296142690080625' );
87}
88
89if($equiv) {
90  is($uniq_count1, 1, 'uniqnum preserves uniqueness of high precision floats');
91  is($uniq_count2, 1, 'uniqnum preserves uniqueness of high precision floats (stringified)');
92}
93
94else {
95  is($uniq_count1, 2, 'uniqnum preserves uniqueness of high precision floats');
96  is($uniq_count2, 2, 'uniqnum preserves uniqueness of high precision floats (stringified)');
97}
98
99SKIP: {
100    skip ('test not relevant for this perl configuration', 1) unless $Config{nvsize} == 8
101                                                                  && $Config{ivsize} == 8;
102
103    my @in = (~0, ~0 - 1, 18446744073709551614.0, 18014398509481985, 1.8014398509481985e16);
104    my(@correct);
105
106    # On perl-5.6.2 (and perhaps other old versions), ~0 - 1 is assigned to an NV.
107    # This affects the outcome of the following test, so we need to first determine
108    # whether ~0 - 1 is an NV or a UV:
109
110    if("$in[1]" eq "1.84467440737096e+19") {
111
112      # It's an NV and $in[2] is a duplicate of $in[1]
113      @correct = (~0, ~0 - 1, 18014398509481985, 1.8014398509481985e16);
114    }
115    else {
116
117      # No duplicates in @in
118      @correct = @in;
119    }
120
121    is_deeply( [ uniqnum @in ],
122               [ @correct ],
123               'uniqnum correctly compares UV/IVs that overflow NVs' );
124}
125
126my $ls = 31;      # maximum left shift for 32-bit unity
127
128if( $Config{ivsize} == 8 ) {
129  $ls       = 63; # maximum left shift for 64-bit unity
130}
131
132# Populate @in with UV-NV pairs of equivalent values.
133# Each of these values is exactly representable as
134# either a UV or an NV.
135
136my @in = (1 << $ls, 2 ** $ls,
137          1 << ($ls - 3), 2 ** ($ls - 3),
138          5 << ($ls - 3), 5 * (2 ** ($ls - 3)));
139
140my @correct = (1 << $ls, 1 << ($ls - 3), 5 << ($ls -3));
141
142if( $Config{ivsize} == 8 && $Config{nvsize} == 8 ) {
143
144     # Add some more UV-NV pairs of equivalent values.
145     # Each of these values is exactly representable
146     # as either a UV or an NV.
147
148     push @in, ( 9007199254740991,     9.007199254740991e+15,
149                 9007199254740992,     9.007199254740992e+15,
150                 9223372036854774784,  9.223372036854774784e+18,
151                 18446744073709549568, 1.8446744073709549568e+19,
152                 18446744073709139968, 1.8446744073709139968e+19,
153                 100000000000262144,   1.00000000000262144e+17,
154                 100000000001310720,   1.0000000000131072e+17,
155                 144115188075593728,   1.44115188075593728e+17,
156                 -9007199254740991,     -9.007199254740991e+15,
157                 -9007199254740992,     -9.007199254740992e+15,
158                 -9223372036854774784,  -9.223372036854774784e+18,
159                 -18446744073709549568, -1.8446744073709549568e+19,
160                 -18446744073709139968, -1.8446744073709139968e+19,
161                 -100000000000262144,   -1.00000000000262144e+17,
162                 -100000000001310720,   -1.0000000000131072e+17,
163                 -144115188075593728,   -1.44115188075593728e+17 );
164
165     push @correct, ( 9007199254740991,
166                      9007199254740992,
167                      9223372036854774784,
168                      18446744073709549568,
169                      18446744073709139968,
170                      100000000000262144,
171                      100000000001310720,
172                      144115188075593728,
173                      -9007199254740991,
174                      -9007199254740992,
175                      -9223372036854774784,
176                      -18446744073709549568,
177                      -18446744073709139968,
178                      -100000000000262144,
179                      -100000000001310720,
180                      -144115188075593728 );
181}
182
183# uniqnum should discard each of the NVs as being a
184# duplicate of the preceding UV.
185
186is_deeply( [ uniqnum @in],
187           [ @correct],
188           'uniqnum correctly compares UV/IVs that don\'t overflow NVs' );
189
190# Hard to know for sure what an Inf is going to be. Lets make one
191my $Inf = 0 + 1E1000;
192my $NaN;
193$Inf **= 1000 while ( $NaN = $Inf - $Inf ) == $NaN;
194
195is_deeply( [ uniqnum 0, 1, 12345, $Inf, -$Inf, $NaN, 0, $Inf, $NaN ],
196           [ 0, 1, 12345, $Inf, -$Inf, $NaN ],
197           'uniqnum preserves the special values of +-Inf and Nan' );
198
199SKIP: {
200    my $maxuint = ~0;
201    my $maxint = ~0 >> 1;
202    my $minint = -(~0 >> 1) - 1;
203
204    my @nums = ($maxuint, $maxuint-1, -1, $maxint, $minint, 1 );
205
206    {
207        use warnings FATAL => 'numeric';
208        if (eval {
209            "$Inf" + 0 == $Inf
210        }) {
211            push @nums, $Inf;
212        }
213        if (eval {
214            my $nanish = "$NaN" + 0;
215            $nanish != 0 && !$nanish != $NaN;
216        }) {
217            push @nums, $NaN;
218        }
219    }
220
221    is_deeply( [ uniqnum @nums, 1.0 ],
222               [ @nums ],
223               'uniqnum preserves uniqueness of full integer range' );
224
225    my @strs = map "$_", @nums;
226
227    if($maxuint !~ /\A[0-9]+\z/) {
228      skip( "Perl $] doesn't stringify UV_MAX right ($maxuint)", 1 );
229    }
230
231    is_deeply( [ uniqnum @strs, "1.0" ],
232               [ @strs ],
233               'uniqnum preserves uniqueness of full integer range (stringified)' );
234}
235
236{
237    my @nums = (6.82132005170133e-38, 62345678);
238    is_deeply( [ uniqnum @nums ], [ @nums ],
239        'uniqnum keeps uniqueness of numbers that stringify to the same byte pattern as a float'
240    );
241}
242
243{
244    my $warnings = "";
245    local $SIG{__WARN__} = sub { $warnings .= join "", @_ };
246
247    is_deeply( [ uniqnum 0, undef ],
248               [ 0 ],
249               'uniqnum considers undef and zero equivalent' );
250
251    ok( length $warnings, 'uniqnum on undef yields a warning' );
252
253    is_deeply( [ uniqnum undef ],
254               [ 0 ],
255               'uniqnum on undef coerces to zero' );
256}
257
258is_deeply( [uniqnum 0, -0.0 ],
259           [0],
260           'uniqnum handles negative zero');
261
262SKIP: {
263    skip ('test not relevant for this perl configuration', 4) unless $Config{ivsize} == 8;
264
265  # 1e17 is the number beyond which "%.20g" formatting fails on some
266  # 64-bit int perls.
267  # The following 2 tests check that the nearest values (both above
268  # and below that tipping point) are being handled correctly.
269
270  # 99999999999999984 is the largest 64-bit integer less than 1e17
271  # that can be expressed exactly as a double
272
273  is_deeply( [ uniqnum (99999999999999984, 99999999999999984.0) ],
274             [ (99999999999999984) ],
275             'uniqnum recognizes 99999999999999984 and 99999999999999984.0 as the same' );
276
277  is_deeply( [ uniqnum (-99999999999999984, -99999999999999984.0) ],
278             [ (-99999999999999984) ],
279             'uniqnum recognizes -99999999999999984 and -99999999999999984.0 as the same' );
280
281  # 100000000000000016 is the smallest positive 64-bit integer greater than 1e17
282  # that can be expressed exactly as a double
283
284  is_deeply( [ uniqnum (100000000000000016, 100000000000000016.0) ],
285             [ (100000000000000016) ],
286             'uniqnum recognizes 100000000000000016 and 100000000000000016.0 as the same' );
287
288  is_deeply( [ uniqnum (-100000000000000016, -100000000000000016.0) ],
289             [ (-100000000000000016) ],
290             'uniqnum recognizes -100000000000000016 and -100000000000000016.0 as the same' );
291}
292
293# uniqnum not confused by IV'ified floats
294SKIP: {
295    # This fails on 5.6 and isn't fixable without breaking a lot of other tests
296    skip 'This perl version gets confused by IVNV dualvars', 1 if $] lt '5.008000';
297    my @nums = ( 2.1, 2.2, 2.3 );
298    my $dummy = sprintf "%d", $_ for @nums;
299
300    # All @nums now have both NOK and IOK but IV=2 in each case
301    is( scalar( uniqnum @nums ), 3, 'uniqnum not confused by dual IV+NV' );
302}
303
304{
305    package Numify;
306
307    use overload '0+' => sub { return $_[0]->{num} };
308
309    sub new { bless { num => $_[1] }, $_[0] }
310
311    package main;
312    use Scalar::Util qw( refaddr );
313
314    my @nums = map { Numify->new( $_ ) } qw( 2 2 5 );
315
316    # is_deeply wants to use eq overloading
317    my @ret = uniqnum @nums;
318    ok( scalar @ret == 2 &&
319        refaddr $ret[0] == refaddr $nums[0] &&
320        refaddr $ret[1] == refaddr $nums[2],
321               'uniqnum respects numify overload' );
322}
323
324{
325    "1 1 2" =~ m/(.) (.) (.)/;
326    is_deeply( [ uniqnum $1, $2, $3 ],
327               [ 1, 2 ],
328               'uniqnum handles magic' );
329}
330