81 lines
2.7 KiB
Diff
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
|
||
|
|
|