* It prints "Missing operator before end of line" if there's nothing
* after the missing operator, or "... before <...>" if there is something
* after the missing operator.
+ *
+ * PL_bufptr is expected to point to the start of the thing that was found,
+ * and s after the next token or partial token.
*/
STATIC void
*/
#define LEX_FAKE_EOF 0x80000000
-#define LEX_NO_TERM 0x40000000
+#define LEX_NO_TERM 0x40000000 /* here-doc */
bool
Perl_lex_next_chunk(pTHX_ U32 flags)
bool got_some;
if (flags & ~(LEX_KEEP_PREVIOUS|LEX_FAKE_EOF|LEX_NO_TERM))
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_next_chunk");
+ if (!(flags & LEX_NO_TERM) && PL_lex_inwhat)
+ return FALSE;
linestr = PL_parser->linestr;
buf = SvPVX(linestr);
if (!(flags & LEX_KEEP_PREVIOUS) &&
incline(s);
need_incline = 0;
}
+ } else if (!c) {
+ s++;
} else {
break;
}
{
PERL_ARGS_ASSERT_SKIPSPACE_FLAGS;
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
- while (s < PL_bufend && SPACE_OR_TAB(*s))
+ while (s < PL_bufend && (SPACE_OR_TAB(*s) || !*s))
s++;
} else {
STRLEN bufptr_pos = PL_bufptr - SvPVX(PL_linestr);
PL_bufptr = s;
lex_read_space(flags | LEX_KEEP_PREVIOUS |
- (PL_sublex_info.sub_inwhat || PL_lex_state == LEX_FORMLINE ?
+ (PL_lex_inwhat || PL_lex_state == LEX_FORMLINE ?
LEX_NO_NEXT_CHUNK : 0));
s = PL_bufptr;
PL_bufptr = SvPVX(PL_linestr) + bufptr_pos;
tokereport(type, &NEXTVAL_NEXTTOKE);
}
#endif
+ assert(PL_nexttoke < C_ARRAY_LENGTH(PL_nexttype));
PL_nexttype[PL_nexttoke] = type;
PL_nexttoke++;
if (PL_lex_state != LEX_KNOWNEXT) {
return THING;
}
if (op_type == OP_CONST) {
- SV *sv = tokeq(PL_lex_stuff);
+ SV *sv = PL_lex_stuff;
+ PL_lex_stuff = NULL;
+ sv = tokeq(sv);
if (SvTYPE(sv) == SVt_PVIV) {
/* Overloaded constants, nothing fancy: Convert to SVt_PV: */
sv = nsv;
}
pl_yylval.opval = (OP*)newSVOP(op_type, 0, sv);
- PL_lex_stuff = NULL;
return THING;
}
PL_lex_stuff = NULL;
PL_sublex_info.repl = NULL;
+ /* Arrange for PL_lex_stuff to be freed on scope exit, in case it gets
+ set for an inner quote-like operator and then an error causes scope-
+ popping. We must not have a PL_lex_stuff value left dangling, as
+ that breaks assumptions elsewhere. See bug #123617. */
+ SAVEGENERICSV(PL_lex_stuff);
+ SAVEGENERICSV(PL_sublex_info.repl);
+
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
= SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
PL_bufend = SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
PL_expect = XOPERATOR;
- PL_sublex_info.sub_inwhat = 0;
return ')';
}
}
/* Here it looks like a named character */
if (*s == 'U' && s[1] == '+') { /* \N{U+...} */
- I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
- | PERL_SCAN_SILENT_ILLDIGIT
- | PERL_SCAN_DISALLOW_PREFIX;
- STRLEN len;
-
s += 2; /* Skip to next char after the 'U+' */
- len = e - s;
- uv = grok_hex(s, &len, &flags, NULL);
- if (len == 0
- || ( len != (STRLEN)(e - s) && s[len] != '.'
- && PL_lex_inpat))
- {
- bad_NU:
- yyerror("Invalid hexadecimal number in \\N{U+...}");
- s = e + 1;
- continue;
- }
-
if (PL_lex_inpat) {
/* In patterns, we can have \N{U+xxxx.yyyy.zzzz...} */
- const char * const orig_s = s - 5;
- while (*s == '.') {
- s++;
- len = e - s;
- uv = grok_hex(s, &len, &flags, NULL);
- if (!len
- || (len != (STRLEN)(e - s) && s[len] != '.'))
- goto bad_NU;
+ /* Check the syntax. */
+ const char *orig_s;
+ orig_s = s - 5;
+ if (!isXDIGIT(*s)) {
+ bad_NU:
+ yyerror(
+ "Invalid hexadecimal number in \\N{U+...}"
+ );
+ s = e + 1;
+ continue;
+ }
+ while (++s < e) {
+ if (isXDIGIT(*s))
+ continue;
+ else if ((*s == '.' || *s == '_')
+ && isXDIGIT(s[1]))
+ continue;
+ goto bad_NU;
}
- /* Pass everything through unchanged. The reason we
- * evaluate the numbers is to make sure there wasn't a
- * syntax error. +1 is for the '}' */
+ /* Pass everything through unchanged.
+ * +1 is for the '}' */
Copy(orig_s, d, e - orig_s + 1, char);
d += e - orig_s + 1;
}
else { /* Not a pattern: convert the hex to string */
+ I32 flags = PERL_SCAN_ALLOW_UNDERSCORES
+ | PERL_SCAN_SILENT_ILLDIGIT
+ | PERL_SCAN_DISALLOW_PREFIX;
+ STRLEN len = e - s;
+ uv = grok_hex(s, &len, &flags, NULL);
+ if (len == 0 || (len != (STRLEN)(e - s)))
+ goto bad_NU;
/* If the destination is not in utf8, unconditionally
* recode it to be so. This is because \N{} implies
SvREFCNT_dec(tmp);
} );
- switch (PL_lex_state) {
- case LEX_NORMAL:
- case LEX_INTERPNORMAL:
- break;
-
/* when we've already built the next token, just pull it out of the queue */
- case LEX_KNOWNEXT:
+ if (PL_nexttoke) {
PL_nexttoke--;
pl_yylval = PL_nextval[PL_nexttoke];
if (!PL_nexttoke) {
}
return REPORT(next_type == 'p' ? pending_ident() : next_type);
}
+ }
+
+ switch (PL_lex_state) {
+ case LEX_NORMAL:
+ case LEX_INTERPNORMAL:
+ break;
/* interpolated case modifiers like \L \U, including \Q and \E.
when we get here, PL_bufptr is at the \
/* FALLTHROUGH */
case LEX_INTERPEND:
+ /* Treat state as LEX_NORMAL if we have no inner lexing scope.
+ XXX This hack can be removed if we stop setting PL_lex_state to
+ LEX_KNOWNEXT, as can the hack under LEX_INTREPCONCAT below. */
+ if (UNLIKELY(!PL_lex_inwhat)) {
+ PL_lex_state = LEX_NORMAL;
+ break;
+ }
+
if (PL_lex_dojoin) {
const U8 dojoin_was = PL_lex_dojoin;
PL_lex_dojoin = FALSE;
Perl_croak(aTHX_ "panic: INTERPCONCAT, lex_brackets=%ld",
(long) PL_lex_brackets);
#endif
+ /* Treat state as LEX_NORMAL when not in an inner lexing scope.
+ XXX This hack can be removed if we stop setting PL_lex_state to
+ LEX_KNOWNEXT. */
+ if (UNLIKELY(!PL_lex_inwhat)) {
+ PL_lex_state = LEX_NORMAL;
+ break;
+ }
+
if (PL_bufptr == PL_bufend)
return REPORT(sublex_done());
case 26:
goto fake_eof; /* emulate EOF on ^D or ^Z */
case 0:
- if (!PL_rsfp && (!PL_parser->filtered || s+1 < PL_bufend)) {
+ if ((!PL_rsfp || PL_lex_inwhat)
+ && (!PL_parser->filtered || s+1 < PL_bufend)) {
PL_last_uni = 0;
PL_last_lop = 0;
if (PL_lex_brackets &&
}
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_lex_state = LEX_FORMLINE;
- NEXTVAL_NEXTTOKE.ival = 0;
force_next(FORMRBRACK);
TOKEN(';');
}
incline(s);
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_lex_state = LEX_FORMLINE;
- NEXTVAL_NEXTTOKE.ival = 0;
force_next(FORMRBRACK);
TOKEN(';');
}
sv_catsv(sv, PL_lex_stuff);
attrs = op_append_elem(OP_LIST, attrs,
newSVOP(OP_CONST, 0, sv));
- SvREFCNT_dec(PL_lex_stuff);
+ SvREFCNT_dec_NN(PL_lex_stuff);
PL_lex_stuff = NULL;
}
else {
PL_tokenbuf[0] = '&';
s = scan_ident(s - 1, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, TRUE);
+ pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
if (PL_tokenbuf[1]) {
- PL_expect = XOPERATOR;
force_ident_maybe_lex('&');
}
else
PREREF('&');
- pl_yylval.ival = (OPpENTERSUB_AMPER<<8);
TERM('&');
case '|':
PL_tokenbuf[0] = '$';
s = scan_ident(s, PL_tokenbuf + 1,
sizeof PL_tokenbuf - 1, FALSE);
- if (PL_expect == XOPERATOR)
- no_op("Scalar", s);
+ if (PL_expect == XOPERATOR) {
+ d = s;
+ if (PL_bufptr > s) {
+ d = PL_bufptr-1;
+ PL_bufptr = PL_oldbufptr;
+ }
+ no_op("Scalar", d);
+ }
if (!PL_tokenbuf[1]) {
if (s == PL_bufend)
yyerror("Final $ should be \\$ or $name");
}
if (!words)
words = newNULLLIST();
- if (PL_lex_stuff) {
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = NULL;
- }
+ SvREFCNT_dec_NN(PL_lex_stuff);
+ PL_lex_stuff = NULL;
PL_expect = XOPERATOR;
pl_yylval.opval = sawparens(words);
TOKEN(QWLIST);
PERL_ARGS_ASSERT_SCAN_IDENT;
- if (isSPACE(*s))
+ if (isSPACE(*s) || !*s)
s = skipspace(s);
if (isDIGIT(*s)) {
while (isDIGIT(*s)) {
first_line = CopLINE(PL_curcop);
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
if (!s) {
- if (PL_lex_stuff) {
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = NULL;
- }
+ SvREFCNT_dec_NN(PL_lex_stuff);
+ PL_lex_stuff = NULL;
Perl_croak(aTHX_ "Substitution replacement not terminated");
}
PL_multi_start = first_start; /* so whole substitution is taken together */
s = scan_str(s,FALSE,FALSE,FALSE,NULL);
if (!s) {
- if (PL_lex_stuff) {
- SvREFCNT_dec(PL_lex_stuff);
- PL_lex_stuff = NULL;
- }
+ SvREFCNT_dec_NN(PL_lex_stuff);
+ PL_lex_stuff = NULL;
Perl_croak(aTHX_ "Transliteration replacement not terminated");
}
https://perl5.git.perl.org / perl5.git / blobdiff