This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
extra tests for grok_number(_flags)()
[perl5.git] / ext / XS-APItest / t / grok.t
1 #!perl -w
2 use strict;
3
4 use Test::More;
5 use Config;
6 use XS::APItest;
7 use feature 'switch';
8 no warnings 'experimental::smartmatch';
9 use constant TRUTH => '0 but true';
10
11 # Tests for grok_number. Not yet comprehensive.
12 foreach my $leader ('', ' ', '  ') {
13     foreach my $trailer ('', ' ', '  ') {
14         foreach ((map {"0" x $_} 1 .. 12),
15                  (map {("0" x $_) . "1"} 0 .. 12),
16                  (map {"1" . ("0" x $_)} 1 .. 9),
17                  (map {1 << $_} 0 .. 31),
18                  (map {1 << $_} 0 .. 31),
19                  (map {0xFFFFFFFF >> $_} reverse (0 .. 31)),
20                 ) {
21             foreach my $sign ('', '-', '+') {
22                 my $string = $leader . $sign . $_ . $trailer;
23                 my ($flags, $value) = grok_number($string);
24                 is($flags & IS_NUMBER_IN_UV, IS_NUMBER_IN_UV,
25                    "'$string' is a UV");
26                 is($flags & IS_NUMBER_NEG, $sign eq '-' ? IS_NUMBER_NEG : 0,
27                    "'$string' sign");
28                 is($value, abs $string, "value is correct");
29             }
30         }
31
32         {
33             my (@UV, @NV);
34             given ($Config{ivsize}) {
35                 when (4) {
36                     @UV = qw(429496729  4294967290 4294967294 4294967295);
37                     @NV = qw(4294967296 4294967297 4294967300 4294967304);
38                 }
39                 when (8) {
40                     @UV = qw(1844674407370955161  18446744073709551610
41                              18446744073709551614 18446744073709551615);
42                     @NV = qw(18446744073709551616 18446744073709551617
43                              18446744073709551620 18446744073709551624);
44                 }
45                 default {
46                     die "Unknown IV size $_";
47                 }
48             }
49             foreach (@UV) {
50                 my $string = $leader . $_ . $trailer;
51                 my ($flags, $value) = grok_number($string);
52                 is($flags & IS_NUMBER_IN_UV, IS_NUMBER_IN_UV,
53                    "'$string' is a UV");
54                 is($value, abs $string, "value is correct");
55             }
56             foreach (@NV) {
57                 my $string = $leader . $_ . $trailer;
58                 my ($flags, $value) = grok_number($string);
59                 is($flags & IS_NUMBER_IN_UV, 0, "'$string' is an NV");
60                 is($value, undef, "value is correct");
61             }
62         }
63
64         my $string = $leader . TRUTH . $trailer;
65         my ($flags, $value) = grok_number($string);
66
67         if ($string eq TRUTH) {
68             is($flags & IS_NUMBER_IN_UV, IS_NUMBER_IN_UV, "'$string' is a UV");
69             is($value, 0);
70         } else {
71             is($flags, 0, "'$string' is not a number");
72             is($value, undef);
73         }
74     }
75 }
76
77 # format tests
78 my @groks =
79   (
80    # input, in flags, out uv, out flags
81    [ "1",    0,                  1,     IS_NUMBER_IN_UV ],
82    [ "1x",   0,                  undef, 0 ],
83    [ "1x",   PERL_SCAN_TRAILING, 1,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
84    [ "3.1",  0,                  3,     IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT ],
85    [ "3.1a", 0,                  undef, 0 ],
86    [ "3.1a", PERL_SCAN_TRAILING, 3,
87      IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING ],
88    [ "3e5",  0,                  undef, IS_NUMBER_NOT_INT ],
89    [ "3e",   0,                  undef, 0 ],
90    [ "3e",   PERL_SCAN_TRAILING, 3,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
91    [ "3e+",  0,                  undef, 0 ],
92    [ "3e+",  PERL_SCAN_TRAILING, 3,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
93    [ "Inf",  0,                  undef,
94      IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT ],
95    [ "In",   0,                  undef, 0 ],
96    [ "Infin",0,                  undef, 0 ],
97    # this doesn't work and hasn't been needed yet
98    #[ "Infin",PERL_SCAN_TRAILING, undef,
99    #  IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING ],
100    [ "nan",  0,                  undef, IS_NUMBER_NAN | IS_NUMBER_NOT_INT ],
101    [ "nanx", 0,                  undef, 0 ],
102    [ "nanx", PERL_SCAN_TRAILING, undef,
103      IS_NUMBER_NAN | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING],
104   );
105
106 for my $grok (@groks) {
107   my ($out_flags, $out_uv) = grok_number_flags($grok->[0], $grok->[1]);
108   is($out_uv,    $grok->[2], "'$grok->[0]' flags $grok->[1] - check number");
109   is($out_flags, $grok->[3], "'$grok->[0]' flags $grok->[1] - check flags");
110 }
111
112 done_testing();