Create my_atof3()

This is like my_atof2(), but with an extra argument signifying the
length of the input string to parse.  If that length is 0, it uses
strlen() to determine it.

Then my_atof2() just calls my_atof3() with a zero final parameter.
And this commit just uses the bulk of the current my_atof2() as the core
of my_atof3().  Changes were needed however, because it relied on
NUL-termination in a number of places.

This allows one to convert a string that isn't necessarily
NUL-terminated to an NV.

Author: khwilliamson

embed.fnc

@@ -2909,7 +2909,8 @@ Apd	|char*	|sv_pvn_force_flags|NN SV *const sv|NULLOK STRLEN *const lp|const I32
 Apmb	|void	|sv_copypv	|NN SV *const dsv|NN SV *const ssv
 Apmd	|void	|sv_copypv_nomg	|NN SV *const dsv|NN SV *const ssv
 Apd	|void	|sv_copypv_flags	|NN SV *const dsv|NN SV *const ssv|const I32 flags
-Ap	|char*	|my_atof2	|NN const char *orig|NN NV* value
+Apo	|char*	|my_atof2	|NN const char *orig|NN NV* value
+Ap	|char*	|my_atof3	|NN const char *orig|NN NV* value|const STRLEN len
 Apn	|int	|my_socketpair	|int family|int type|int protocol|int fd[2]
 Apn	|int	|my_dirfd	|NULLOK DIR* dir
 #ifdef PERL_ANY_COW

embed.h

@@ -476,7 +476,7 @@
 #define mro_get_linear_isa(a)	Perl_mro_get_linear_isa(aTHX_ a)
 #define mro_method_changed_in(a)	Perl_mro_method_changed_in(aTHX_ a)
 #define my_atof(a)		Perl_my_atof(aTHX_ a)
-#define my_atof2(a,b)		Perl_my_atof2(aTHX_ a,b)
+#define my_atof3(a,b,c)		Perl_my_atof3(aTHX_ a,b,c)
 #define my_dirfd		Perl_my_dirfd
 #define my_exit(a)		Perl_my_exit(aTHX_ a)
 #define my_failure_exit()	Perl_my_failure_exit(aTHX)

numeric.c

@@ -1228,7 +1228,7 @@ Perl_my_atof(pTHX_ const char* s)
 
 #ifdef USE_QUADMATH
 
-    Perl_my_atof2(aTHX_ s, &x);
+    my_atof2(s, &x);
 
 #elif ! defined(USE_LOCALE_NUMERIC)
 
@@ -1366,11 +1366,20 @@ S_my_atof_infnan(pTHX_ const char* s, bool negative, const char* send, NV* value
 
 char*
 Perl_my_atof2(pTHX_ const char* orig, NV* value)
+{
+    PERL_ARGS_ASSERT_MY_ATOF2;
+    return my_atof3(orig, value, 0);
+}
+
+char*
+Perl_my_atof3(pTHX_ const char* orig, NV* value, STRLEN len)
 {
     const char* s = orig;
     NV result[3] = {0.0, 0.0, 0.0};
 #if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
-    const char* send = s + strlen(orig); /* one past the last */
+    const char* send = s + ((len != 0)
+                           ? len
+                           : strlen(orig)); /* one past the last */
     bool negative = 0;
 #endif
 #if defined(USE_PERL_ATOF) && !defined(USE_QUADMATH)
@@ -1387,10 +1396,10 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 #endif
 
 #if defined(USE_PERL_ATOF) || defined(USE_QUADMATH)
-    PERL_ARGS_ASSERT_MY_ATOF2;
+    PERL_ARGS_ASSERT_MY_ATOF3;
 
     /* leading whitespace */
-    while (isSPACE(*s))
+    while (s < send && isSPACE(*s))
 	++s;
 
     /* sign */
@@ -1408,6 +1417,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
         char* endp;
         if ((endp = S_my_atof_infnan(aTHX_ s, negative, send, value)))
             return endp;
+        endp = send;
         result[2] = strtoflt128(s, &endp);
         if (s != endp) {
             *value = negative ? -result[2] : result[2];
@@ -1457,7 +1467,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
     /* we accumulate digits into an integer; when this becomes too
      * large, we add the total to NV and start again */
 
-    while (1) {
+    while (s < send) {
 	if (isDIGIT(*s)) {
 	    seen_digit = 1;
 	    old_digit = digit;
@@ -1485,7 +1495,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 		    exp_adjust[0]++;
 		}
 		/* skip remaining digits */
-		while (isDIGIT(*s)) {
+		while (s < send && isDIGIT(*s)) {
 		    ++s;
 		    if (! seen_dp) {
 			exp_adjust[0]++;
@@ -1509,7 +1519,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 	else if (!seen_dp && GROK_NUMERIC_RADIX(&s, send)) {
 	    seen_dp = 1;
 	    if (sig_digits > MAX_SIG_DIGITS) {
-		while (isDIGIT(*s)) {
+		while (s < send && isDIGIT(*s)) {
 		    ++s;
 		}
 		break;
@@ -1525,7 +1535,7 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 	result[1] = S_mulexp10(result[1], exp_acc[1]) + (NV)accumulator[1];
     }
 
-    if (seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) {
+    if (s < send && seen_digit && (isALPHA_FOLD_EQ(*s, 'e'))) {
 	bool expnegative = 0;
 
 	++s;
@@ -1536,14 +1546,12 @@ Perl_my_atof2(pTHX_ const char* orig, NV* value)
 	    case '+':
 		++s;
 	}
-	while (isDIGIT(*s))
+	while (s < send && isDIGIT(*s))
 	    exponent = exponent * 10 + (*s++ - '0');
 	if (expnegative)
 	    exponent = -exponent;
     }
 
-
-
     /* now apply the exponent */
 
     if (seen_dp) {

perl.h

@@ -2328,11 +2328,12 @@ int isnan(double d);
 
 #ifdef USE_PERL_ATOF
 #   define Perl_atof(s) Perl_my_atof(s)
-#   define Perl_atof2(s, n) Perl_my_atof2(aTHX_ (s), &(n))
+#   define Perl_atof2(s, n) Perl_my_atof3(aTHX_ (s), &(n), 0)
 #else
 #   define Perl_atof(s) (NV)atof(s)
 #   define Perl_atof2(s, n) ((n) = atof(s))
 #endif
+#define my_atof2(a,b) my_atof3(a,b,0)
 
 /*
  * CHAR_MIN and CHAR_MAX are not included here, as the (char) type may be

pod/perlclib.pod

@@ -205,7 +205,7 @@ C<toUPPER_uni>, as described in L<perlapi/Character case changing>.)
  atof(s)                     Atof(s)
  atoi(s)                     grok_atoUV(s, &uv, &e)
  atol(s)                     grok_atoUV(s, &uv, &e)
- strtod(s, &p)               Nothing.  Just don't use it.
+ strtod(s, &p)               my_atof3(s, &nv, &p) is the closest we have
  strtol(s, &p, n)            grok_atoUV(s, &uv, &e)
  strtoul(s, &p, n)           grok_atoUV(s, &uv, &e)
 

proto.h

@@ -2220,6 +2220,9 @@ PERL_CALLCONV NV	Perl_my_atof(pTHX_ const char *s);
 PERL_CALLCONV char*	Perl_my_atof2(pTHX_ const char *orig, NV* value);
 #define PERL_ARGS_ASSERT_MY_ATOF2	\
 	assert(orig); assert(value)
+PERL_CALLCONV char*	Perl_my_atof3(pTHX_ const char *orig, NV* value, const STRLEN len);
+#define PERL_ARGS_ASSERT_MY_ATOF3	\
+	assert(orig); assert(value)
 PERL_CALLCONV OP *	Perl_my_attrs(pTHX_ OP *o, OP *attrs);
 #define PERL_ARGS_ASSERT_MY_ATTRS	\
 	assert(o)