This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
APItest: Add comprehensive UTF-8 validity tests
[perl5.git] / ext / XS-APItest / numeric.xs
1 MODULE = XS::APItest            PACKAGE = XS::APItest::numeric
2
3 void
4 grok_number(number)
5         SV *number
6     PREINIT:
7         STRLEN len;
8         const char *pv = SvPV(number, len);
9         UV value;
10         int result;
11     PPCODE:
12         EXTEND(SP,2);
13         result = grok_number(pv, len, &value);
14         PUSHs(sv_2mortal(newSViv(result)));
15         if (result & IS_NUMBER_IN_UV)
16             PUSHs(sv_2mortal(newSVuv(value)));
17
18 void
19 grok_number_flags(number, flags)
20         SV *number
21         U32 flags
22     PREINIT:
23         STRLEN len;
24         const char *pv = SvPV(number, len);
25         UV value;
26         int result;
27     PPCODE:
28         EXTEND(SP,2);
29         result = grok_number_flags(pv, len, &value, flags);
30         PUSHs(sv_2mortal(newSViv(result)));
31         if (result & IS_NUMBER_IN_UV)
32             PUSHs(sv_2mortal(newSVuv(value)));
33
34 void
35 grok_atoUV(number, endsv)
36         SV *number
37         SV *endsv
38     PREINIT:
39         STRLEN len;
40         const char *pv = SvPV(number, len);
41         UV value = 0xdeadbeef;
42         bool result;
43         const char* endptr = pv + len;
44     PPCODE:
45         EXTEND(SP,2);
46         if (endsv == &PL_sv_undef) {
47           result = grok_atoUV(pv, &value, NULL);
48         } else {
49           result = grok_atoUV(pv, &value, &endptr);
50         }
51         PUSHs(result ? &PL_sv_yes : &PL_sv_no);
52         PUSHs(sv_2mortal(newSVuv(value)));
53         if (endsv == &PL_sv_undef) {
54           PUSHs(sv_2mortal(newSVpvn(NULL, 0)));
55         } else {
56           if (endptr) {
57             PUSHs(sv_2mortal(newSViv(endptr - pv)));
58           } else {
59             PUSHs(sv_2mortal(newSViv(0)));
60           }
61         }