Add two more flags to grok_bin_oct_hex

These add enough functionality so that other code that rolled its own
version of this can call it instead and get the desired functionality.

One flag silences warnings about overflow.  It would be more consistent
to use the existing flag that gets set when overflow is detected to
silence the warnings if set on input.  But that would be a change in
(undocumented) behavior, and I thought it better to not chance breaking
something.

The other flag forbids an initial underscore when medial underscores are
allowed.  I wasn't aware until I examined the code and documentation
carefully that the flag that I thought allowed  single underscores
between digits, actually also allows for an initial underscore.  I can't
imagine why that was the case, but \N{U+...} never allowed initial
underscores, and adding a flag to grok_hex to allow just medial
underscores allows \N{} in a future commit  to change to use grok_hex()
without changing behavior.

Neither flag is currently exposed outside of the core or extensions

2 files changed, 18 insertions, 2 deletions

diff --git a/numeric.c b/numeric.c
index ad75f63373..4c2f12b8cd 100644
--- a/numeric.c
+++ b/numeric.c
@@ -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;
diff --git a/perl.h b/perl.h
index 7fbbd59a38..c374da7399 100644
--- a/perl.h
+++ b/perl.h
@@ -7150,6 +7150,12 @@ A synonym for L</grok_numeric_radix>
 /* If this is set on input, and no illegal digit is found, it will be cleared
  * on output; otherwise unchanged */
 #  define PERL_SCAN_NOTIFY_ILLDIGIT 0x40
+
+/* Don't warn on overflow; output flag still set */
+#  define PERL_SCAN_SILENT_OVERFLOW 0x80
+
+/* Forbid a leading underscore, which the other one doesn't */
+#  define PERL_SCAN_ALLOW_MEDIAL_UNDERSCORES (0x100|PERL_SCAN_ALLOW_UNDERSCORES)
 #endif