extra tests for grok_number(_flags)()

diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL
index 031ce8a..173e5c9 100644 (file)
--- a/ext/XS-APItest/Makefile.PL
+++ b/ext/XS-APItest/Makefile.PL
@@ -24,7 +24,7 @@ my @names = (qw(HV_DELETE HV_DISABLE_UVAR_XKEY HV_FETCH_ISSTORE
                G_KEEPERR G_NODEBUG G_METHOD G_FAKINGEVAL
                IS_NUMBER_IN_UV IS_NUMBER_GREATER_THAN_UV_MAX
                IS_NUMBER_NOT_INT IS_NUMBER_NEG IS_NUMBER_INFINITY
-               IS_NUMBER_NAN
+               IS_NUMBER_NAN IS_NUMBER_TRAILING PERL_SCAN_TRAILING
                ),
             {name=>"G_WANT", default=>["IV", "G_ARRAY|G_VOID"]});
 

diff --git a/ext/XS-APItest/numeric.xs b/ext/XS-APItest/numeric.xs
index b06258d..ab48dba 100644 (file)
--- a/ext/XS-APItest/numeric.xs
+++ b/ext/XS-APItest/numeric.xs
@@ -14,3 +14,19 @@ grok_number(number)
        PUSHs(sv_2mortal(newSViv(result)));
        if (result & IS_NUMBER_IN_UV)
            PUSHs(sv_2mortal(newSVuv(value)));
+
+void
+grok_number_flags(number, flags)
+       SV *number
+       U32 flags
+    PREINIT:
+       STRLEN len;
+       const char *pv = SvPV(number, len);
+       UV value;
+       int result;
+    PPCODE:
+       EXTEND(SP,2);
+       result = grok_number_flags(pv, len, &value, flags);
+       PUSHs(sv_2mortal(newSViv(result)));
+       if (result & IS_NUMBER_IN_UV)
+           PUSHs(sv_2mortal(newSVuv(value)));

diff --git a/ext/XS-APItest/t/grok.t b/ext/XS-APItest/t/grok.t
index 99fbc5d..2e035ee 100644 (file)
--- a/ext/XS-APItest/t/grok.t
+++ b/ext/XS-APItest/t/grok.t
@@ -74,4 +74,39 @@ foreach my $leader ('', ' ', '  ') {
     }
 }
 
+# format tests
+my @groks =
+  (
+   # input, in flags, out uv, out flags
+   [ "1",    0,                  1,     IS_NUMBER_IN_UV ],
+   [ "1x",   0,                  undef, 0 ],
+   [ "1x",   PERL_SCAN_TRAILING, 1,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
+   [ "3.1",  0,                  3,     IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT ],
+   [ "3.1a", 0,                  undef, 0 ],
+   [ "3.1a", PERL_SCAN_TRAILING, 3,
+     IS_NUMBER_IN_UV | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING ],
+   [ "3e5",  0,                  undef, IS_NUMBER_NOT_INT ],
+   [ "3e",   0,                  undef, 0 ],
+   [ "3e",   PERL_SCAN_TRAILING, 3,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
+   [ "3e+",  0,                  undef, 0 ],
+   [ "3e+",  PERL_SCAN_TRAILING, 3,     IS_NUMBER_IN_UV | IS_NUMBER_TRAILING ],
+   [ "Inf",  0,                  undef,
+     IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT ],
+   [ "In",   0,                  undef, 0 ],
+   [ "Infin",0,                  undef, 0 ],
+   # this doesn't work and hasn't been needed yet
+   #[ "Infin",PERL_SCAN_TRAILING, undef,
+   #  IS_NUMBER_INFINITY | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING ],
+   [ "nan",  0,                  undef, IS_NUMBER_NAN | IS_NUMBER_NOT_INT ],
+   [ "nanx", 0,                  undef, 0 ],
+   [ "nanx", PERL_SCAN_TRAILING, undef,
+     IS_NUMBER_NAN | IS_NUMBER_NOT_INT | IS_NUMBER_TRAILING],
+  );
+
+for my $grok (@groks) {
+  my ($out_flags, $out_uv) = grok_number_flags($grok->[0], $grok->[1]);
+  is($out_uv,    $grok->[2], "'$grok->[0]' flags $grok->[1] - check number");
+  is($out_flags, $grok->[3], "'$grok->[0]' flags $grok->[1] - check flags");
+}
+
 done_testing();