diff options
author | TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com> | 2021-02-19 01:11:13 +0900 |
---|---|---|
committer | Karl Williamson <khw@cpan.org> | 2021-07-25 05:57:43 -0700 |
commit | 7035863f5fa4306e58c8157b2a5893ba5e0f1eaf (patch) | |
tree | 302631d6743ad1679b047b680df0f5ca97007594 | |
parent | d44f69e7cc06ab513c9a2784013a0a8f91003726 (diff) | |
download | perl-7035863f5fa4306e58c8157b2a5893ba5e0f1eaf.tar.gz |
Perl_my_atof3: disallow double signs and spaces between a sign and number
Perl_my_atof3 used to pass a substring after the first (optional) sign
to (S_)strtod, which causes wrong numifications for strings like "-+3"
or "+ 0x123" (for the latter case, while Perl_my_atof3 already had
the code to block "0x" prefixes, this string will slip through due to
the space character in it).
For GH #18584.
-rw-r--r-- | MANIFEST | 1 | ||||
-rw-r--r-- | numeric.c | 9 | ||||
-rw-r--r-- | t/op/numify.t | 42 |
3 files changed, 50 insertions, 2 deletions
@@ -5922,6 +5922,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 @@ -1675,6 +1675,10 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len) return (char *)s+1; } + /* strtod will parse a sign (and skip leading whitespaces) by itself, + * so rewind s to the beginning of the string. */ + 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 +1686,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 +1700,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; diff --git a/t/op/numify.t b/t/op/numify.t new file mode 100644 index 0000000000..7a0db56537 --- /dev/null +++ b/t/op/numify.t @@ -0,0 +1,42 @@ +#! ./perl + +# Test string-to-number conversions. + +BEGIN { + chdir 't' if -d 't'; + require './test.pl'; + set_up_inc('../lib'); +} + +use strict; +use warnings; + +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]) { + 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(); |