}
if (name)
Perl_sv_catpv(aTHX_ report, name);
- else if ((char)rv > ' ' && (char)rv < '~')
+ else if ((char)rv > ' ' && (char)rv <= '~')
Perl_sv_catpvf(aTHX_ report, "'%c'", (char)rv);
else if (!rv)
sv_catpvs(report, "EOF");
incline(s);
}
else {
+ const bool in_comment = *s == '#';
d = s;
while (d < PL_bufend && *d != '\n')
d++;
PL_thiswhite = newSVpvn(s, d - s);
#endif
s = d;
- incline(s);
+ if (in_comment && d == PL_bufend
+ && PL_lex_state == LEX_INTERPNORMAL
+ && PL_lex_inwhat == OP_SUBST && PL_lex_repl == PL_linestr
+ && SvEVALED(PL_lex_repl) && d[-1] == '}') s--;
+ else incline(s);
}
if (PL_lex_formbrack && PL_lex_brackets <= PL_lex_formbrack) {
PL_lex_state = LEX_FORMLINE;
}
switch (PL_expect) {
case XTERM:
- if (PL_oldoldbufptr == PL_last_lop)
- PL_lex_brackstack[PL_lex_brackets++] = XTERM;
- else
- PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
+ PL_lex_brackstack[PL_lex_brackets++] = XOPERATOR;
PL_lex_allbrackets++;
OPERATOR(HASHBRACK);
case XOPERATOR:
#endif
return yylex(); /* ignore fake brackets */
}
- if (*s == '-' && s[1] == '>')
+ if (PL_lex_inwhat == OP_SUBST && PL_lex_repl == PL_linestr
+ && SvEVALED(PL_lex_repl))
+ PL_lex_state = LEX_INTERPEND;
+ else if (*s == '-' && s[1] == '>')
PL_lex_state = LEX_INTERPENDMAYBE;
else if (*s != '[' && *s != '{')
PL_lex_state = LEX_INTERPEND;
}
sv_catpvs(repl, "{");
sv_catsv(repl, PL_sublex_info.repl);
- if (strchr(SvPVX(PL_sublex_info.repl), '#'))
- sv_catpvs(repl, "\n");
sv_catpvs(repl, "}");
SvEVALED_on(repl);
SvREFCNT_dec(PL_sublex_info.repl);
a whole string being evalled, or the contents of the current quote-
like operator.
- The three methods are:
- - Steal lines from the input stream (stream)
- - Scan the heredoc in PL_linestr and remove it therefrom (linestr)
- - Peek at the PL_linestr of outer lexing scopes (peek)
-
- They are used in these cases:
- file scope or filtered eval stream
- string eval linestr
- multiline quoted construct linestr
- single-line quoted construct in file stream
- single-line quoted construct in eval or quote peek
+ The two basic methods are:
+ - Steal lines from the input stream
+ - Scan the heredoc in PL_linestr and remove it therefrom
- Single-line also applies to heredocs that begin on the last line of a
- quote-like operator.
+ In a file scope or filtered eval, the first method is used; in a
+ string eval, the second.
- Peeking within a quote also involves falling back to the stream method,
- if the outer quote-like operators are all on one line (or the heredoc
- marker is on the last line).
+ In a quote-like operator, we have to choose between the two,
+ depending on where we can find a newline. We peek into outer lex-
+ ing scopes until we find one with a newline in it. If we reach the
+ outermost lexing scope and it is a file, we use the stream method.
+ Otherwise it is treated as an eval.
*/
STATIC char *
S_scan_heredoc(pTHX_ register char *s)
{
dVAR;
- SV *herewas;
I32 op_type = OP_SCALAR;
I32 len;
SV *tmpstr;
char term;
- const char *found_newline = 0;
char *d;
char *e;
char *peek;
s = olds;
}
#endif
- if ((infile && !PL_lex_inwhat)
- || !(found_newline = (char*)memchr((void*)s, '\n', PL_bufend - s))) {
- herewas = newSVpvn(s,PL_bufend-s);
- }
- else {
-#ifdef PERL_MAD
- herewas = newSVpvn(s-1,found_newline-s+1);
-#else
- s--;
- herewas = newSVpvn(s,found_newline-s);
-#endif
- }
#ifdef PERL_MAD
if (PL_madskills) {
tstart = SvPVX(PL_linestr) + stuffstart;
else
PL_thisstuff = newSVpvn(tstart, s - tstart);
}
-#endif
- s += SvCUR(herewas);
-#ifdef PERL_MAD
stuffstart = s - SvPVX(PL_linestr);
-
- if (found_newline)
- s--;
#endif
tmpstr = newSV_type(SVt_PVIV);
PL_multi_start = CopLINE(PL_curcop) + 1;
PL_multi_open = PL_multi_close = '<';
- if (PL_lex_inwhat && !found_newline) {
- /* Peek into the line buffer of the parent lexing scope, going up
- as many levels as necessary to find one with a newline after
- bufptr. See the comments in sublex_push for how IVX and NVX
- are abused.
- */
+ /* inside a string eval or quote-like operator */
+ if (!infile || PL_lex_inwhat) {
SV *linestr;
- char *bufptr, *bufend;
- char * const olds = s - SvCUR(herewas);
- char * const real_olds = s;
+ char *bufend;
+ char * const olds = s;
PERL_CONTEXT * const cx = &cxstack[cxstack_ix];
- do {
+ /* These two fields are not set until an inner lexing scope is
+ entered. But we need them set here. */
+ shared->ls_bufptr = s;
+ shared->ls_linestr = PL_linestr;
+ if (PL_lex_inwhat)
+ /* Look for a newline. If the current buffer does not have one,
+ peek into the line buffer of the parent lexing scope, going
+ up as many levels as necessary to find one with a newline
+ after bufptr.
+ */
+ while (!(s = (char *)memchr(
+ (void *)shared->ls_bufptr, '\n',
+ SvEND(shared->ls_linestr)-shared->ls_bufptr
+ ))) {
shared = shared->ls_prev;
/* shared is only null if we have gone beyond the outermost
lexing scope. In a file, we will have broken out of the
most lexing scope. In a file, shared->ls_linestr at that
level is just one line, so there is no body to steal. */
if (infile && !shared->ls_prev) {
- s = real_olds;
+ s = olds;
goto streaming;
}
- } while (!(s = (char *)memchr(
- (void *)shared->ls_bufptr, '\n',
- SvEND(shared->ls_linestr)-shared->ls_bufptr
- )));
- bufptr = shared->ls_bufptr;
+ }
+ else { /* eval */
+ s = (char*)memchr((void*)s, '\n', PL_bufend - s);
+ assert(s);
+ }
linestr = shared->ls_linestr;
bufend = SvEND(linestr);
d = s;
++shared->herelines;
}
if (s >= bufend) {
- SvREFCNT_dec(herewas);
- SvREFCNT_dec(tmpstr);
- CopLINE_set(PL_curcop, (line_t)PL_multi_start-1);
- missingterm(PL_tokenbuf + 1);
- }
- sv_setpvn(herewas,bufptr,d-bufptr+1);
- sv_setpvn(tmpstr,d+1,s-d);
- s += len - 1;
- /* See the Paranoia note in case LEX_INTERPEND in yylex, for why we
- check shared->re_eval_str. */
- if (shared->re_eval_start || shared->re_eval_str) {
- /* Set aside the rest of the regexp */
- if (!shared->re_eval_str)
- shared->re_eval_str =
- newSVpvn(shared->re_eval_start,
- SvEND(linestr) - shared->re_eval_start);
- shared->re_eval_start -= s-d;
- }
- if (CxTYPE(cx) == CXt_EVAL && CxOLD_OP_TYPE(cx) == OP_ENTEREVAL
- && cx->blk_eval.cur_text == linestr) {
- cx->blk_eval.cur_text = newSVsv(linestr);
- SvSCREAM_on(cx->blk_eval.cur_text);
- }
- sv_catpvn(herewas,s,bufend-s);
- Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
- SvCUR_set(linestr,
- bufptr-SvPVX_const(linestr)
- + SvCUR(herewas));
-
- s = olds;
- goto retval;
- }
- else if (!infile || found_newline) {
- char * const olds = s - SvCUR(herewas);
- PERL_CONTEXT * const cx = &cxstack[cxstack_ix];
- d = s;
- while (s < PL_bufend &&
- (*s != '\n' || memNE(s,PL_tokenbuf,len)) ) {
- if (*s++ == '\n')
- ++shared->herelines;
- }
- if (s >= PL_bufend) {
- SvREFCNT_dec(herewas);
- SvREFCNT_dec(tmpstr);
- CopLINE_set(PL_curcop, (line_t)PL_multi_start-1);
- missingterm(PL_tokenbuf + 1);
+ goto interminable;
}
sv_setpvn(tmpstr,d+1,s-d);
#ifdef PERL_MAD
/* s now points to the newline after the heredoc terminator.
d points to the newline before the body of the heredoc.
*/
+
+ /* We are going to modify linestr in place here, so set
+ aside copies of the string if necessary for re-evals or
+ (caller $n)[6]. */
/* See the Paranoia note in case LEX_INTERPEND in yylex, for why we
check shared->re_eval_str. */
if (shared->re_eval_start || shared->re_eval_str) {
if (!shared->re_eval_str)
shared->re_eval_str =
newSVpvn(shared->re_eval_start,
- PL_bufend - shared->re_eval_start);
+ bufend - shared->re_eval_start);
shared->re_eval_start -= s-d;
}
if (CxTYPE(cx) == CXt_EVAL && CxOLD_OP_TYPE(cx) == OP_ENTEREVAL
- && cx->blk_eval.cur_text == PL_linestr) {
- cx->blk_eval.cur_text = newSVsv(PL_linestr);
+ && cx->blk_eval.cur_text == linestr) {
+ cx->blk_eval.cur_text = newSVsv(linestr);
SvSCREAM_on(cx->blk_eval.cur_text);
}
/* Copy everything from s onwards back to d. */
- Move(s,d,PL_bufend-s + 1,char);
- SvCUR_set(PL_linestr, SvCUR(PL_linestr) - (s-d));
- PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
+ Move(s,d,bufend-s + 1,char);
+ SvCUR_set(linestr, SvCUR(linestr) - (s-d));
+ /* Setting PL_bufend only applies when we have not dug deeper
+ into other scopes, because sublex_done sets PL_bufend to
+ SvEND(PL_linestr). */
+ if (shared == PL_parser->lex_shared) PL_bufend = SvEND(linestr);
s = olds;
}
else
term = PL_tokenbuf[1];
len--;
linestr_save = PL_linestr; /* must restore this afterwards */
- d = s - SvCUR(herewas) - 1; /* s gets set to this afterwards */
+ d = s; /* and this */
PL_linestr = newSVpvs("");
- PL_bufptr = PL_bufend = s = SvPVX(PL_linestr);
- while (s >= PL_bufend) { /* multiple line string? */
+ PL_bufend = SvPVX(PL_linestr);
+ while (1) {
#ifdef PERL_MAD
if (PL_madskills) {
tstart = SvPVX(PL_linestr) + stuffstart;
PL_thisstuff = newSVpvn(tstart, PL_bufend - tstart);
}
#endif
- PL_bufptr = s;
+ PL_bufptr = PL_bufend;
CopLINE_set(PL_curcop,
PL_multi_start + shared->herelines);
if (!lex_next_chunk(LEX_NO_TERM)
&& (!SvCUR(tmpstr) || SvEND(tmpstr)[-1] != '\n')) {
- SvREFCNT_dec(herewas);
- SvREFCNT_dec(tmpstr);
SvREFCNT_dec(linestr_save);
- CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
- missingterm(PL_tokenbuf + 1);
+ goto interminable;
}
CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') {
stuffstart = s - SvPVX(PL_linestr);
#endif
shared->herelines++;
- PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
#ifndef PERL_STRICT_CR
if (PL_bufend - PL_linestart >= 2) {
PL_linestart = SvPVX(linestr_save);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
s = d;
+ break;
}
else {
- s = PL_bufend;
sv_catsv(tmpstr,PL_linestr);
}
}
}
- s++;
-retval:
PL_multi_end = CopLINE(PL_curcop);
if (SvCUR(tmpstr) + 5 < SvLEN(tmpstr)) {
SvPV_shrink_to_cur(tmpstr);
}
- SvREFCNT_dec(herewas);
if (!IN_BYTES) {
if (UTF && is_utf8_string((U8*)SvPVX_const(tmpstr), SvCUR(tmpstr)))
SvUTF8_on(tmpstr);
PL_lex_stuff = tmpstr;
pl_yylval.ival = op_type;
return s;
+
+ interminable:
+ SvREFCNT_dec(tmpstr);
+ CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
+ missingterm(PL_tokenbuf + 1);
}
/* scan_inputsymbol
https://perl5.git.perl.org / perl5.git / blobdiff