This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Use grok_atou instead of atoi.
[perl5.git] / ext / XS-APItest / t / grok.t
CommitLineData
ffe53d21
NC
1#!perl -w
2use strict;
3
4use Test::More;
5use Config;
6use XS::APItest;
7use feature 'switch';
0f539b13 8no warnings 'experimental::smartmatch';
ffe53d21
NC
9use constant TRUTH => '0 but true';
10
11# Tests for grok_number. Not yet comprehensive.
12foreach 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
e222d7e2
TC
77# format tests
78my @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
106for 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
ffe53d21 112done_testing();