diff --git a/MANIFEST b/MANIFEST index df0e398a10c6..c9847282a6a7 100644 --- a/MANIFEST +++ b/MANIFEST @@ -5888,6 +5888,7 @@ t/op/mydef.t See if "my $_" works t/op/negate.t See if unary minus works t/op/not.t See if not works t/op/numconvert.t See if accessing fields does not change numeric values +t/op/numify.t See if string-to-number conversion works t/op/oct.t See if oct and hex work t/op/or.t See if || works in weird situations t/op/ord.t See if ord works diff --git a/numeric.c b/numeric.c index 72130dd9f521..d2f4165f1dd5 100644 --- a/numeric.c +++ b/numeric.c @@ -1648,6 +1648,14 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) while (s < send && isSPACE(*s)) ++s; +# if defined(NV_INF) || defined(NV_NAN) + { + char* endp; + if ((endp = S_my_atof_infnan(aTHX_ s, FALSE, send, value))) + return endp; + } +# endif + /* sign */ switch (*s) { case '-': @@ -1663,9 +1671,6 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) char* endp; char* copy = NULL; - if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value))) - return endp; - /* strtold() accepts 0x-prefixed hex and in POSIX implementations, 0b-prefixed binary numbers, which is backward incompatible */ @@ -1675,6 +1680,11 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) return (char *)s+1; } + /* We do not want strtod to parse whitespace after the sign, since + * that would give backward-incompatible results. So we rewind and + * let strtod handle the whitespace and sign character itself. */ + s = orig; + /* If the length is passed in, the input string isn't NUL-terminated, * and in it turns out the function below assumes it is; therefore we * create a copy and NUL-terminate that */ @@ -1682,7 +1692,7 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) Newx(copy, len + 1, char); Copy(orig, copy, len, char); copy[len] = '\0'; - s = copy + (s - orig); + s = copy; } result[2] = S_strtod(aTHX_ s, &endp); @@ -1696,7 +1706,8 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) } if (s != endp) { - *value = negative ? -result[2] : result[2]; + /* Note that negation is handled by strtod. */ + *value = result[2]; return endp; } return NULL; @@ -1732,14 +1743,6 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) /* the max number we can accumulate in a UV, and still safely do 10*N+9 */ #define MAX_ACCUMULATE ( (UV) ((UV_MAX - 9)/10)) -#if defined(NV_INF) || defined(NV_NAN) - { - char* endp; - if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value))) - return endp; - } -#endif - /* we accumulate digits into an integer; when this becomes too * large, we add the total to NV and start again */ diff --git a/t/op/numify.t b/t/op/numify.t new file mode 100644 index 000000000000..f1f27a86a287 --- /dev/null +++ b/t/op/numify.t @@ -0,0 +1,54 @@ +#! ./perl + +# Test string-to-number conversions. + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc('../lib'); +} + +use strict; +use warnings; + +# Quick test if NV supports infinities. +# Note that this would be $Config{d_double_has_inf}, but this is only valid +# if NV is configured as double. +my $nv_has_inf = do { no warnings; 'inf' > 0 }; + +foreach ([' +3', 3, 0], + ["10.\t", 10, 0], + ['abc', 0, 1], + ['- +3', 0, 1], # GH 18584 + ['++4', 0, 1], + ['0x123', 0, 1], + ['1x123', 1, 1], + ['+0x456', 0, 1], + ['- 0x789', 0, 1], + ['0b101', 0, 1], + ['-3.14', -3.14, 0], + ['- 3.14', 0, 1], + ($nv_has_inf ? + (['+infinity ', '+Inf', 0], + [' -infin', '-Inf', 1], + ['+ inf', 0, 1], + ['+-inf', 0, 1]) : + ()) + ) { + my ($str, $num, $warn) = @$_; + + my $code = sub { + cmp_ok($str + 0, '==', $num, "numifying '$str'"); + }; + + if ($warn) { + warning_like($code, qr/^Argument ".*" isn't numeric/, + "numifying '$str' trigger a warning"); + } + else { + warning_is($code, undef, + "numifying '$str' does not trigger warnings"); + } +} + +done_testing();