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.

1 files changed, 11 insertions, 4 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;