In perl.git, the branch blead has been updated

<https://perl5.git.perl.org/perl.git/commitdiff/8348ac19a3c37caf807ef0f64320e0bec53b6747?hp=82007f754ed1e129a53fc7c964d84cddba7ca0de>

- Log -----------------------------------------------------------------
commit 8348ac19a3c37caf807ef0f64320e0bec53b6747
Author: Tony Cook <[email protected]>
Date:   Wed Jul 31 11:06:20 2019 +1000

    (perl #134310) don't confuse S_no_op()
    
    This code could previously set PL_bufptr so it points after the
    returned s pointer, which S_no_op() asserts on for the test case.
    
    Since setting PL_bufptr here is useful when producing the error
    message, just make sure we restore it.

-----------------------------------------------------------------------

Summary of changes:
 t/lib/croak/toke | 12 ++++++++++++
 toke.c           |  2 ++
 2 files changed, 14 insertions(+)

diff --git a/t/lib/croak/toke b/t/lib/croak/toke
index 4ef6f726fc..3c32f088fd 100644
--- a/t/lib/croak/toke
+++ b/t/lib/croak/toke
@@ -528,3 +528,15 @@ qq!$x\U@{s{0})(?{!;
 EXPECT
 syntax error at - line 3, near ")("
 Execution of - aborted due to compilation errors.
+########
+# NAME [perl #134310] don't confuse S_no_op() with PL_bufptr after s
+0 0x@
+EXPECT
+Number found where operator expected at - line 1, near "0 0x"
+       (Missing operator before  0x?)
+Array found where operator expected at - line 1, near "0x@
+;"
+       (Missing operator before ;?)
+No digits found for hexadecimal literal at - line 1, near "0 0x@"
+syntax error at - line 1, near "0 0x"
+Execution of - aborted due to compilation errors.
diff --git a/toke.c b/toke.c
index 2f794d69b9..26de580a24 100644
--- a/toke.c
+++ b/toke.c
@@ -11342,10 +11342,12 @@ Perl_scan_num(pTHX_ const char *start, YYSTYPE* lvalp)
                    behaviour, like for: "0x.3" and "0x+$foo".
                 */
                 const char *d = s;
+                char *oldbp = PL_bufptr;
                 if (*d) ++d; /* so the user sees the bad non-digit */
                 PL_bufptr = (char *)d; /* so yyerror reports the context */
                 yyerror(Perl_form(aTHX_ "No digits found for %s literal",
                                   shift == 4 ? "hexadecimal" : "binary"));
+                PL_bufptr = oldbp;
             }
 
            if (overflowed) {

-- 
Perl5 Master Repository

Reply via email to