In perl.git, the branch blead has been updated <http://perl5.git.perl.org/perl.git/commitdiff/00c7fba717c4212ca81ed1a46acf38ed3685c27c?hp=62a74c3704bd55cf2797db36535df425e3e0c675>
- Log ----------------------------------------------------------------- commit 00c7fba717c4212ca81ed1a46acf38ed3685c27c Author: Karl Williamson <[email protected]> Date: Sun Jan 29 20:59:44 2017 -0700 Add test for [perl #129036] This was fixed by 6cdc5cd8f36f88172b0fcefdcadec75f5b6600b2 (but I didn't check that this was the actual commit). M t/lib/warnings/toke commit d2067945159644d284f8064efbd41024f9e8448a Author: Karl Williamson <[email protected]> Date: Sun Jan 29 15:56:20 2017 -0700 PATCH: [perl #130666]: Revert "toke.c, S_scan_ident(): Don't take a "end of buffer" argument, use PL_bufend" This reverts commit b5248d1e210c2a723adae8e9b7f5d17076647431. This commit, dating from 2013, was made unnecessary by later removal of the MAD code. It temporarily changed the PL_bufend variable; doing that ran afoul of an assertion, added in fac0f7a38edc4e50a7250b738699165079b852d8, that expects PL_bufend to point to a terminating NUL. Beyond the reversion, a test is added here. M embed.fnc M embed.h M proto.h M t/lib/warnings/toke M toke.c ----------------------------------------------------------------------- Summary of changes: embed.fnc | 2 +- embed.h | 2 +- proto.h | 4 ++-- t/lib/warnings/toke | 12 ++++++++++++ toke.c | 19 ++++++++----------- 5 files changed, 24 insertions(+), 15 deletions(-) diff --git a/embed.fnc b/embed.fnc index ae7e8d75a4..d84f31353b 100644 --- a/embed.fnc +++ b/embed.fnc @@ -2645,7 +2645,7 @@ sR |SV* |get_and_check_backslash_N_name|NN const char* s \ |NN const char* const e sR |char* |scan_formline |NN char *s sR |char* |scan_heredoc |NN char *s -s |char* |scan_ident |NN char *s|NN char *dest \ +s |char* |scan_ident |NN char *s|NN const char *send|NN char *dest \ |STRLEN destlen|I32 ck_uni sR |char* |scan_inputsymbol|NN char *start sR |char* |scan_pat |NN char *start|I32 type diff --git a/embed.h b/embed.h index 2233a35e80..72950ae44b 100644 --- a/embed.h +++ b/embed.h @@ -1815,7 +1815,7 @@ #define scan_const(a) S_scan_const(aTHX_ a) #define scan_formline(a) S_scan_formline(aTHX_ a) #define scan_heredoc(a) S_scan_heredoc(aTHX_ a) -#define scan_ident(a,b,c,d) S_scan_ident(aTHX_ a,b,c,d) +#define scan_ident(a,b,c,d,e) S_scan_ident(aTHX_ a,b,c,d,e) #define scan_inputsymbol(a) S_scan_inputsymbol(aTHX_ a) #define scan_pat(a,b) S_scan_pat(aTHX_ a,b) #define scan_str(a,b,c,d,e) S_scan_str(aTHX_ a,b,c,d,e) diff --git a/proto.h b/proto.h index 7ec784981a..46556eec17 100644 --- a/proto.h +++ b/proto.h @@ -5552,9 +5552,9 @@ STATIC char* S_scan_heredoc(pTHX_ char *s) #define PERL_ARGS_ASSERT_SCAN_HEREDOC \ assert(s) -STATIC char* S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni); +STATIC char* S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni); #define PERL_ARGS_ASSERT_SCAN_IDENT \ - assert(s); assert(dest) + assert(s); assert(send); assert(dest) STATIC char* S_scan_inputsymbol(pTHX_ char *start) __attribute__warn_unused_result__; #define PERL_ARGS_ASSERT_SCAN_INPUTSYMBOL \ diff --git a/t/lib/warnings/toke b/t/lib/warnings/toke index 1f971e88d2..2774f08dd1 100644 --- a/t/lib/warnings/toke +++ b/t/lib/warnings/toke @@ -1637,3 +1637,15 @@ EXPECT OPTION fatal Malformed UTF-8 character: \xc3\x20 (unexpected non-continuation byte 0x20, immediately after start byte 0xc3; need 2 bytes, got 1) in eval "string" at - line 11. Malformed UTF-8 character (fatal) at - line 11. +######## +# NAME [perl $130666] Assertion failure +no warnings "uninitialized"; +BEGIN{$^H=-1};my $l; s$0[$l] +EXPECT +######## +# NAME [perl $129036] Assertion failure +BEGIN{$0="";$^H=hex join""=>A00000}p? +EXPECT +OPTION fatal +syntax error at - line 1, at EOF +Execution of - aborted due to compilation errors. diff --git a/toke.c b/toke.c index 864c5269c3..10ee5007c6 100644 --- a/toke.c +++ b/toke.c @@ -4166,10 +4166,7 @@ S_intuit_more(pTHX_ char *s) weight -= seen[un_char] * 10; if (isWORDCHAR_lazy_if_safe(s+1, PL_bufend, UTF)) { int len; - char *tmp = PL_bufend; - PL_bufend = (char*)send; - scan_ident(s, tmpbuf, sizeof tmpbuf, FALSE); - PL_bufend = tmp; + scan_ident(s, send, tmpbuf, sizeof tmpbuf, FALSE); len = (int)strlen(tmpbuf); if (len > 1 && gv_fetchpvn_flags(tmpbuf, len, UTF ? SVf_UTF8 : 0, SVt_PV)) @@ -5693,7 +5690,7 @@ Perl_yylex(pTHX) case '*': if (PL_expect == XPOSTDEREF) POSTDEREF('*'); if (PL_expect != XOPERATOR) { - s = scan_ident(s, PL_tokenbuf, sizeof PL_tokenbuf, TRUE); + s = scan_ident(s, PL_bufend, PL_tokenbuf, sizeof PL_tokenbuf, TRUE); PL_expect = XOPERATOR; force_ident(PL_tokenbuf, '*'); if (!*PL_tokenbuf) @@ -5736,7 +5733,7 @@ Perl_yylex(pTHX) } else if (PL_expect == XPOSTDEREF) POSTDEREF('%'); PL_tokenbuf[0] = '%'; - s = scan_ident(s, PL_tokenbuf + 1, + s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); pl_yylval.ival = 0; if (!PL_tokenbuf[1]) { @@ -6283,7 +6280,7 @@ Perl_yylex(pTHX) } PL_tokenbuf[0] = '&'; - s = scan_ident(s - 1, PL_tokenbuf + 1, + s = scan_ident(s - 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, TRUE); pl_yylval.ival = (OPpENTERSUB_AMPER<<8); if (PL_tokenbuf[1]) { @@ -6546,7 +6543,7 @@ Perl_yylex(pTHX) || strchr("{$:+-@", s[2]))) { PL_tokenbuf[0] = '@'; - s = scan_ident(s + 1, PL_tokenbuf + 1, + s = scan_ident(s + 1, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); if (PL_expect == XOPERATOR) { d = s; @@ -6564,7 +6561,7 @@ Perl_yylex(pTHX) } PL_tokenbuf[0] = '$'; - s = scan_ident(s, PL_tokenbuf + 1, + s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); if (PL_expect == XOPERATOR) { d = s; @@ -6700,7 +6697,7 @@ Perl_yylex(pTHX) if (PL_expect == XPOSTDEREF) POSTDEREF('@'); PL_tokenbuf[0] = '@'; - s = scan_ident(s, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); + s = scan_ident(s, PL_bufend, PL_tokenbuf + 1, sizeof PL_tokenbuf - 1, FALSE); if (PL_expect == XOPERATOR) { d = s; if (PL_bufptr > s) { @@ -9260,7 +9257,7 @@ S_scan_word(pTHX_ char *s, char *dest, STRLEN destlen, int allow_package, STRLEN && LIKELY((U8) *(s) != LATIN1_TO_NATIVE(0xAD))))) STATIC char * -S_scan_ident(pTHX_ char *s, char *dest, STRLEN destlen, I32 ck_uni) +S_scan_ident(pTHX_ char *s, const char *send, char *dest, STRLEN destlen, I32 ck_uni) { I32 herelines = PL_parser->herelines; SSize_t bracket = -1; -- Perl5 Master Repository
