(perl #131793) sanely handle PL_linestart > PL_bufptr

In the test case, scan_ident() ends up fetching another line
(updating PL_linestart), and since in this case we don't
successfully parse ${identifier} s (and PL_bufptr) end up being
before PL_linestart.

2 files changed, 23 insertions, 5 deletions

diff --git a/t/comp/parser_run.t b/t/comp/parser_run.t
index e74644d3fb..0fca5b2800 100644
--- a/t/comp/parser_run.t
+++ b/t/comp/parser_run.t
@@ -10,7 +10,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan(1);
+plan(2);
 
 # [perl #130814] can reallocate lineptr while looking ahead for
 # "Missing $ on loop variable" diagnostic.
@@ -24,5 +24,12 @@ syntax error at - line 3, near "foreach m0
 Identifier too long at - line 3.
 EXPECT
 
+fresh_perl_is(<<EOS, <<'EXPECT', {}, "linestart before bufptr");
+\${ \xD5eeeeeeeeeeee
+'x
+EOS
+Unrecognized character \xD5; marked by <-- HERE after ${ <-- HERE near column 4 at - line 1.
+EXPECT
+
 __END__
 # ex: set ts=8 sts=4 sw=4 et:
diff --git a/toke.c b/toke.c
index 6de7d09ea4..3899b729af 100644
--- a/toke.c
+++ b/toke.c
@@ -5158,12 +5158,23 @@ Perl_yylex(pTHX)
         else {
             c = Perl_form(aTHX_ "\\x%02X", (unsigned char)*s);
         }
-        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) PL_linestart, (U8 *) s) : (STRLEN) (s - PL_linestart);
-        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
-            d = UTF ? (char *) utf8_hop_back((U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT, (U8 *)PL_linestart) : s - UNRECOGNIZED_PRECEDE_COUNT;
-        } else {
+
+        if (s >= PL_linestart) {
             d = PL_linestart;
         }
+        else {
+            /* somehow (probably due to a parse failure), PL_linestart has advanced
+             * pass PL_bufptr, get a reasonable beginning of line
+             */
+            d = s;
+            while (d > SvPVX(PL_linestr) && d[-1] && d[-1] != '\n')
+                --d;
+        }
+        len = UTF ? Perl_utf8_length(aTHX_ (U8 *) d, (U8 *) s) : (STRLEN) (s - d);
+        if (len > UNRECOGNIZED_PRECEDE_COUNT) {
+            d = UTF ? (char *) utf8_hop_back((U8 *) s, -UNRECOGNIZED_PRECEDE_COUNT, (U8 *)d) : s - UNRECOGNIZED_PRECEDE_COUNT;
+        }
+
         Perl_croak(aTHX_  "Unrecognized character %s; marked by <-- HERE after %" UTF8f "<-- HERE near column %d", c,
                           UTF8fARG(UTF, (s - d), d),
                          (int) len + 1);