diff options
| author | Tony Cook <tony@develop-help.com> | 2014-05-01 15:37:08 +1000 |
|---|---|---|
| committer | Tony Cook <tony@develop-help.com> | 2014-07-03 15:59:12 +1000 |
| commit | e222d7e21c7c7259563eb80c17e899cf857a1ace (patch) | |
| tree | 50f0a5b84f476ac336daf5c6a2cc6cb07bfcb826 | |
| parent | 3f7602fa4cd6923ae409dbb4a71c27905a0abd30 (diff) | |
| download | perl-e222d7e21c7c7259563eb80c17e899cf857a1ace.tar.gz | |
extra tests for grok_number(_flags)()
| -rw-r--r-- | ext/XS-APItest/Makefile.PL | 2 | ||||
| -rw-r--r-- | ext/XS-APItest/numeric.xs | 16 | ||||
| -rw-r--r-- | ext/XS-APItest/t/grok.t | 35 |
3 files changed, 52 insertions, 1 deletions
diff --git a/ext/XS-APItest/Makefile.PL b/ext/XS-APItest/Makefile.PL index 031ce8a0b0..173e5c97c5 100644 --- 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 b06258d3c1..ab48dba19e 100644 --- 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 99fbc5d3da..2e035ee565 100644 --- 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(); |