regcomp.h: Combine two macros into one

[perl5.git] / numeric.c

diff --git a/numeric.c b/numeric.c
index ad75f63..51a0edf 100644 (file)
--- a/numeric.c
+++ b/numeric.c
@@ -379,7 +379,7 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
 
     /* In overflows, this keeps track of how much to multiply the overflowed NV
      * by as we continue to parse the remaining digits */
-    UV factor;
+    NV factor = 0;
 
     /* This function unifies the core of grok_bin, grok_oct, and grok_hex.  It
      * is optimized for hex conversion.  For example, it uses XDIGIT_VALUE to
@@ -429,42 +429,42 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
       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)) {
@@ -492,7 +492,7 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
                     /* Note XDIGIT_VALUE() is branchless, works on binary
                      * and octal as well, so can be used here, without
                      * slowing those down */
-                factor <<= shift;
+                factor *= 1 << shift;
                 continue;
             }
 
@@ -501,7 +501,7 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
              * value.  Each time through the loop we have increased 'factor' so
              * that it gives how much the current approximation needs to
              * effectively be shifted to make room for this new value */
-            value_nv *= (NV) factor;
+            value_nv *= factor;
             value_nv += (NV) value;
 
             /* Then we keep accumulating digits, until all are parsed.  We
@@ -513,12 +513,16 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
 
             if (! overflowed) {
                 overflowed = TRUE;
-                Perl_ck_warner_d(aTHX_ packWARN(WARN_OVERFLOW),
+                if (   ! (input_flags & PERL_SCAN_SILENT_OVERFLOW)
+                    &&    ckWARN_d(WARN_OVERFLOW))
+                {
+                    Perl_warner(aTHX_ packWARN(WARN_OVERFLOW),
                                        "Integer overflow in %s number",
                                        (base == 16) ? "hexadecimal"
                                                     : (base == 2)
                                                       ? "binary"
                                                       : "octal");
+                }
             }
             continue;
         }
@@ -526,7 +530,13 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
         if (   *s == '_'
             && len
             && allow_underscores
-            && _generic_isCC(s[1], class_bit))
+            && _generic_isCC(s[1], class_bit)
+
+                /* Don't allow a leading underscore if the only-medial bit is
+                 * set */
+            && (   LIKELY(s > s0)
+                || UNLIKELY((input_flags & PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES)
+                                        != PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES)))
         {
             --len;
             ++s;
@@ -580,7 +590,7 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
     }
 
     /* Overflowed: Calculate the final overflow approximation */
-    value_nv *= (NV) factor;
+    value_nv *= factor;
     value_nv += (NV) value;
 
     output_non_portable(base);