Account for 'less' reserving an extra column

[perl5.git] / numeric.c

diff --git a/numeric.c b/numeric.c
index 03bc3a3..52c4547 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -16,9 +16,6 @@
  */
 
 /*
-=head1 Numeric functions
-
-=cut
 
 This file contains all the stuff needed by perl for manipulating numeric
 values, including such things as replacements for the OS's atof() function
@@ -313,7 +310,7 @@ If C<PERL_SCAN_ALLOW_UNDERSCORES> is set in C<*flags> then any or all pairs of
 digits may be separated from each other by a single underscore; also a single
 leading underscore is accepted.
 
-The the C<PERL_SCAN_DISALLOW_PREFIX> flag is always treated as being set for
+The C<PERL_SCAN_DISALLOW_PREFIX> flag is always treated as being set for
 this function.
 
 =cut
@@ -424,47 +421,47 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
     s = s0; /* s0 potentially advanced from 'start' */
 
     /* Unroll the loop so that the first 8 digits are branchless except for the
-     * switch.  A ninth one overflows a 32 bit word. */
+     * switch.  A ninth hex one overflows a 32 bit word. */
     switch (len) {
       case 0:
           return 0;
       default:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 7:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 6:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 5:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 4:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 3:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 2:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
           s++;
           /* FALLTHROUGH */
       case 1:
-          if (! _generic_isCC(*s, class_bit))  break;
+          if (UNLIKELY(! _generic_isCC(*s, class_bit)))  break;
           value = (value << shift) | XDIGIT_VALUE(*s);
 
           if (LIKELY(len <= 8)) {
@@ -726,12 +723,12 @@ If an infinity or a not-a-number is recognized, C<*sp> will point to
 one byte past the end of the recognized string.  If the recognition fails,
 zero is returned, and C<*sp> will not move.
 
-=for apidoc Amn|bool|IS_NUMBER_GREATER_THAN_UV_MAX
-=for apidoc Amn|bool|IS_NUMBER_INFINITY
-=for apidoc Amn|bool|IS_NUMBER_IN_UV
-=for apidoc Amn|bool|IS_NUMBER_NAN
-=for apidoc Amn|bool|IS_NUMBER_NEG
-=for apidoc Amn|bool|IS_NUMBER_NOT_INT
+=for apidoc Amnh|bool|IS_NUMBER_GREATER_THAN_UV_MAX
+=for apidoc Amnh|bool|IS_NUMBER_INFINITY
+=for apidoc Amnh|bool|IS_NUMBER_IN_UV
+=for apidoc Amnh|bool|IS_NUMBER_NAN
+=for apidoc Amnh|bool|IS_NUMBER_NEG
+=for apidoc Amnh|bool|IS_NUMBER_NOT_INT
 
 =cut
 */
@@ -784,7 +781,7 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
                 s++; if (s == send || isALPHA_FOLD_NE(*s, 'Y')) return fail;
                 s++;
             } else if (odh) {
-                while (*s == '0') { /* 1.#INF00 */
+                while (s < send && *s == '0') { /* 1.#INF00 */
                     s++;
                 }
             }
@@ -798,10 +795,10 @@ Perl_grok_infnan(pTHX_ const char** sp, const char* send)
         else if (isALPHA_FOLD_EQ(*s, 'D') && odh) { /* 1.#IND */
             s++;
             flags |= IS_NUMBER_NAN | IS_NUMBER_NOT_INT;
-            while (*s == '0') { /* 1.#IND00 */
+            while (s < send && *s == '0') { /* 1.#IND00 */
                 s++;
             }
-            if (*s) {
+            if (s < send && *s) {
                 flags |= IS_NUMBER_TRAILING;
             }
         } else
@@ -1281,7 +1278,8 @@ If you constrain the portion of C<pv> that is looked at by this function (by
 passing a non-NULL C<endptr>), and if the intial bytes of that portion form a
 valid value, it will return TRUE, setting C<*endptr> to the byte following the
 final digit of the value.  But if there is no constraint at what's looked at,
-all of C<pv> must be valid in order for TRUE to be returned.
+all of C<pv> must be valid in order for TRUE to be returned.  C<*endptr> is
+unchanged from its value on input if FALSE is returned;
 
 The only characters this accepts are the decimal digits '0'..'9'.
 
@@ -1466,7 +1464,18 @@ S_mulexp10(NV value, I32 exponent)
 NV
 Perl_my_atof(pTHX_ const char* s)
 {
-    /* 's' must be NUL terminated */
+
+/*
+=for apidoc my_atof
+
+L<C<atof>(3)>, but properly works with Perl locale handling, accepting a dot
+radix character always, but also the current locale's radix character if and
+only if called from within the lexical scope of a Perl C<use locale> statement.
+
+N.B. C<s> must be NUL terminated.
+
+=cut
+*/
 
     NV x = 0.0;
 
@@ -1831,9 +1840,15 @@ Perl_my_atof3(pTHX_ const char* orig, NV* value, const STRLEN len)
     /* now apply the sign */
     if (negative)
        result[2] = -result[2];
-#endif /* USE_PERL_ATOF */
     *value = result[2];
     return (char *)s;
+#else  /* USE_PERL_ATOF */
+    /* If you see this error you both don't have strtod (or configured -Ud_strtod or
+       or it's long double/quadmath equivalent) and disabled USE_PERL_ATOF, thus
+       removing any way for perl to convert strings to floating point numbers.
+    */
+# error No mechanism to convert strings to numbers available
+#endif
 }
 
 /*