perl/perl-5.27.2-perl-131793-sanely-handle-PL_linestart-PL_bufptr.patch

81 lines
2.7 KiB
Diff

From 36000cd1c47863d8412b285701db7232dd450239 Mon Sep 17 00:00:00 2001
From: Tony Cook <tony@develop-help.com>
Date: Wed, 26 Jul 2017 12:04:18 +1000
Subject: [PATCH] (perl #131793) sanely handle PL_linestart > PL_bufptr
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8
Content-Transfer-Encoding: 8bit
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.
Signed-off-by: Petr Písař <ppisar@redhat.com>
---
t/comp/parser_run.t | 9 ++++++++-
toke.c | 19 +++++++++++++++----
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);
--
2.13.6