grok_bin_oct_hex: Add two output flags

This commit adds two output flags returned from this function to the one
previously existing, so that the caller can be informed of the problems
found and take its own action.

This involves the behavior of two existing flags, whose being set
suppresses the warning if particular conditions exist in the input being
parsed.  Both flags were currently always cleared upon return.

One of those flags is non-public.  I changed it so that it isn't cleared
upon return if the condition it describes is found.

The other flag is public.  I thought that some existing code, though
unlikely,  might be relying on the flag being always cleared.  So I
added a completely new flag from a previously unused bit that, if clear
on input there is no change in behavior; but if set on input, it will
remain set on output if the condition is met; otherwise cleared.  The
only code that could possibly be affected is that which sets this unused
bit, but expects it to be cleared after the return.  This is very
unlikely.

2 files changed, 33 insertions, 10 deletions

diff --git a/numeric.c b/numeric.c
index 58f5a085bc..3a50d6dd4d 100644
--- a/numeric.c
+++ b/numeric.c
@@ -279,7 +279,7 @@ leading underscore is accepted.
 
 Not documented yet because experimental is C<PERL_SCAN_SILENT_NON_PORTABLE>
 which suppresses any message for non-portable numbers, but which are valid
-on this platform.
+on this platform.  But, C<*flags>  will have the corresponding flag bit set.
  */
 
 UV
@@ -533,8 +533,8 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
             goto redo;
         }
 
-        if (      *s
-            && ! (input_flags & PERL_SCAN_SILENT_ILLDIGIT)
+        if (*s) {
+            if (   ! (input_flags & PERL_SCAN_SILENT_ILLDIGIT)
             &&    ckWARN(WARN_DIGIT))
         {
             if (base != 8) {
@@ -554,6 +554,11 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
                  * or 9). */
                 Perl_warner(aTHX_ packWARN(WARN_DIGIT),
                                        "Illegal octal digit '%c' ignored", *s);
+                }
+            }
+
+            if (input_flags & PERL_SCAN_NOTIFY_ILLDIGIT) {
+                *flags |= PERL_SCAN_NOTIFY_ILLDIGIT;
             }
         }
 
@@ -568,6 +573,7 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
             && ! (input_flags & PERL_SCAN_SILENT_NON_PORTABLE))
         {
             output_non_portable(base);
+            *flags |= PERL_SCAN_SILENT_NON_PORTABLE;
         }
 #endif
         return value;
@@ -579,7 +585,8 @@ Perl_grok_bin_oct_hex(pTHX_ const char *start,
 
     output_non_portable(base);
 
-    *flags = PERL_SCAN_GREATER_THAN_UV_MAX;
+    *flags |= PERL_SCAN_GREATER_THAN_UV_MAX
+           |  PERL_SCAN_SILENT_NON_PORTABLE;
     if (result)
         *result = value_nv;
     return UV_MAX;
diff --git a/perl.h b/perl.h
index 0b869913ef..45f47a2b3b 100644
--- a/perl.h
+++ b/perl.h
@@ -7125,17 +7125,33 @@ A synonym for L</grok_numeric_radix>
 */
 #define GROK_NUMERIC_RADIX(sp, send) grok_numeric_radix(sp, send)
 
-/* Input flags: */
+/* Number scan flags.  All are used for input, the ones used for output are so
+ * marked */
 #define PERL_SCAN_ALLOW_UNDERSCORES   0x01 /* grok_??? accept _ in numbers */
 #define PERL_SCAN_DISALLOW_PREFIX     0x02 /* grok_??? reject 0x in hex etc */
-#define PERL_SCAN_SILENT_ILLDIGIT     0x04 /* grok_??? not warn about illegal digits */
-#define PERL_SCAN_SILENT_NON_PORTABLE 0x08 /* grok_??? not warn about very large
-					      numbers which are <= UV_MAX */
+
+/* grok_??? input: don't warn on overflowing a UV; output: found overflow */
+#define PERL_SCAN_GREATER_THAN_UV_MAX 0x04
+
+/* grok_??? don't warn about illegal digits.  To preserve total backcompat,
+ * this isn't set on output if one is found.  Instead, see
+ * PERL_SCAN_NOTIFY_ILLDIGIT. */
+#define PERL_SCAN_SILENT_ILLDIGIT     0x08
+
 #define PERL_SCAN_TRAILING            0x10 /* grok_number_flags() allow trailing
                                               and set IS_NUMBER_TRAILING */
 
-/* Output flags: */
-#define PERL_SCAN_GREATER_THAN_UV_MAX 0x02 /* should this merge with above? */
+#ifdef PERL_CORE    /* These are considered experimental, so not exposed
+                       publicly */
+/* grok_??? don't warn about very large numbers which are <= UV_MAX;
+ * output: found such a number */
+#  define PERL_SCAN_SILENT_NON_PORTABLE 0x20
+
+/* 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
+#endif
+
 
 /* to let user control profiling */
 #ifdef PERL_GPROF_CONTROL