From c4eaeb119985d8b28824519ce8661023e1107f4e Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Fri, 19 Feb 2021 01:11:13 +0900
Subject: [PATCH 1/3] 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.
---
 MANIFEST      |  1 +
 numeric.c     |  9 +++++++--
 t/op/numify.t | 42 ++++++++++++++++++++++++++++++++++++++++++
 3 files changed, 50 insertions(+), 2 deletions(-)
 create mode 100644 t/op/numify.t

diff --git a/MANIFEST b/MANIFEST
index 71d3b453daa6..f736247a8b93 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -5885,6 +5885,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..76f7395d5853 100644
--- a/numeric.c
+++ b/numeric.c
@@ -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 000000000000..7a0db565374f
--- /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();

From 9471a178038569517c04f7ffbead4ff6b05c2d6a Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Tue, 23 Feb 2021 01:11:59 +0900
Subject: [PATCH 2/3] Perl_my_atof3: disallow double signs for Inf/NaN

Perl_my_atof3 used to call S_my_atof_infnan after parsing sign character,
but this led Inf/NaN with double signs (e.g. "+-Inf") to be wrongly accepted
because S_my_atof_infnan will also parse sign itself.

Also improved comment per suggestion from @hvds.
---
 numeric.c | 24 +++++++++++-------------
 1 file changed, 11 insertions(+), 13 deletions(-)

diff --git a/numeric.c b/numeric.c
index 76f7395d5853..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,8 +1680,9 @@ 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. */
+        /* 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,
@@ -1737,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 */
 

From aa09c967d54cfba8bbce4617f8347e5241dd322c Mon Sep 17 00:00:00 2001
From: TAKAI Kousuke <62541129+t-a-k@users.noreply.github.com>
Date: Tue, 23 Feb 2021 01:22:26 +0900
Subject: [PATCH 3/3] t/op/numify.t: More tests to check if invalid Inf/NaNs
 are not numified

---
 t/op/numify.t | 14 +++++++++++++-
 1 file changed, 13 insertions(+), 1 deletion(-)

diff --git a/t/op/numify.t b/t/op/numify.t
index 7a0db565374f..f1f27a86a287 100644
--- a/t/op/numify.t
+++ b/t/op/numify.t
@@ -11,6 +11,11 @@ BEGIN {
 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],
@@ -22,7 +27,14 @@ foreach ([' +3', 3, 0],
          ['- 0x789', 0, 1],
          ['0b101', 0, 1],
          ['-3.14', -3.14, 0],
-         ['- 3.14', 0, 1]) {
+         ['- 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 {