return (int)LSTOP; \
} while(0)
+#define COPLINE_INC_WITH_HERELINES \
+ STMT_START { \
+ CopLINE_inc(PL_curcop); \
+ if (PL_parser->lex_shared->herelines) \
+ CopLINE(PL_curcop) += PL_parser->lex_shared->herelines, \
+ PL_parser->lex_shared->herelines = 0; \
+ } STMT_END
+
+
#ifdef DEBUGGING
/* how to interpret the pl_yylval associated with the token */
Newx(parser->lex_brackstack, 120, char);
Newx(parser->lex_casestack, 12, char);
*parser->lex_casestack = '\0';
+ Newxz(parser->lex_shared, 1, LEXSHARED);
if (line) {
STRLEN len;
parser->linestr = flags & LEX_START_COPIED
? SvREFCNT_inc_simple_NN(line)
: newSVpvn_flags(s, len, SvUTF8(line));
- if (!len || s[len-1] != ';')
- sv_catpvs(parser->linestr, "\n;");
+ sv_catpvs(parser->linestr, "\n;");
} else {
parser->linestr = newSVpvs("\n;");
}
Safefree(parser->lex_brackstack);
Safefree(parser->lex_casestack);
+ Safefree(parser->lex_shared);
PL_parser = parser->old_parser;
Safefree(parser);
}
linestart_pos = PL_parser->linestart - buf;
last_uni_pos = PL_parser->last_uni ? PL_parser->last_uni - buf : 0;
last_lop_pos = PL_parser->last_lop ? PL_parser->last_lop - buf : 0;
- re_eval_start_pos = PL_sublex_info.re_eval_start ?
- PL_sublex_info.re_eval_start - buf : 0;
+ re_eval_start_pos = PL_parser->lex_shared->re_eval_start ?
+ PL_parser->lex_shared->re_eval_start - buf : 0;
buf = sv_grow(linestr, len);
PL_parser->last_uni = buf + last_uni_pos;
if (PL_parser->last_lop)
PL_parser->last_lop = buf + last_lop_pos;
- if (PL_sublex_info.re_eval_start)
- PL_sublex_info.re_eval_start = buf + re_eval_start_pos;
+ if (PL_parser->lex_shared->re_eval_start)
+ PL_parser->lex_shared->re_eval_start = buf + re_eval_start_pos;
return buf;
}
Perl_croak(aTHX_ "Lexing code internal error (%s)", "lex_read_to");
for (; s != ptr; s++)
if (*s == '\n') {
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
PL_parser->linestart = s+1;
}
PL_parser->bufptr = ptr;
c = lex_peek_unichar(flags);
if (c != -1) {
if (c == '\n')
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
if (UTF)
PL_parser->bufptr += UTF8SKIP(PL_parser->bufptr);
else
if (flags & LEX_NO_NEXT_CHUNK)
break;
PL_parser->bufptr = s;
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
got_more = lex_next_chunk(flags);
CopLINE_dec(PL_curcop);
s = PL_parser->bufptr;
PERL_ARGS_ASSERT_INCLINE;
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
if (*s++ != '#')
return;
while (SPACE_OR_TAB(*s))
S_sublex_push(pTHX)
{
dVAR;
+ LEXSHARED *shared;
ENTER;
PL_lex_state = PL_sublex_info.super_state;
SAVEI32(PL_lex_starts);
SAVEI8(PL_lex_state);
SAVESPTR(PL_lex_repl);
- SAVEPPTR(PL_sublex_info.re_eval_start);
- SAVEPPTR(PL_sublex_info.super_bufptr);
SAVEVPTR(PL_lex_inpat);
SAVEI16(PL_lex_inwhat);
SAVECOPLINE(PL_curcop);
SAVESPTR(PL_linestr);
SAVEGENERICPV(PL_lex_brackstack);
SAVEGENERICPV(PL_lex_casestack);
+ SAVEGENERICPV(PL_parser->lex_shared);
/* The here-doc parser needs to be able to peek into outer lexing
- scopes to find the body of the here-doc. We use SvIVX(PL_linestr)
- to store the outer PL_bufptr and SvNVX to store the outer
- PL_linestr. Since SvIVX already means something else, we use
- PL_sublex_info.super_bufptr for the innermost scope (the one we are
- now entering), and a localised SvIVX for outer scopes.
+ scopes to find the body of the here-doc. So we put PL_linestr and
+ PL_bufptr into lex_shared, to ‘share’ those values.
*/
- SvUPGRADE(PL_linestr, SVt_PVIV);
- /* A null super_bufptr means the outer lexing scope is not peekable,
- because it is a single line from an input stream. */
- SAVEIV(SvIVX(PL_linestr));
- SvIVX(PL_linestr) = PTR2IV(PL_sublex_info.super_bufptr);
- PL_sublex_info.super_bufptr =
- (SvTYPE(PL_linestr) < SVt_PVNV || !SvNVX(PL_linestr))
- && (PL_rsfp || PL_parser->filtered)
- ? NULL
- : PL_bufptr;
- SvUPGRADE(PL_lex_stuff, SVt_PVNV);
- SvNVX(PL_lex_stuff) = PTR2NV(PL_linestr);
+ PL_parser->lex_shared->ls_linestr = PL_linestr;
+ PL_parser->lex_shared->ls_bufptr = PL_bufptr;
PL_linestr = PL_lex_stuff;
PL_lex_repl = PL_sublex_info.repl;
PL_lex_stuff = NULL;
PL_sublex_info.repl = NULL;
- PL_sublex_info.re_eval_start = NULL;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart
= SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
SAVEFREESV(PL_linestr);
+ if (PL_lex_repl) SAVEFREESV(PL_lex_repl);
PL_lex_dojoin = FALSE;
PL_lex_brackets = PL_lex_formbrack = 0;
PL_lex_starts = 0;
PL_lex_state = LEX_INTERPCONCAT;
CopLINE_set(PL_curcop, (line_t)PL_multi_start);
+
+ Newxz(shared, 1, LEXSHARED);
+ shared->ls_prev = PL_parser->lex_shared;
+ PL_parser->lex_shared = shared;
PL_lex_inwhat = PL_sublex_info.sub_inwhat;
if (PL_lex_inwhat == OP_TRANSR) PL_lex_inwhat = OP_TRANS;
/* Is there a right-hand side to take care of? (s//RHS/ or tr//RHS/) */
assert(PL_lex_inwhat != OP_TRANSR);
if (PL_lex_repl && (PL_lex_inwhat == OP_SUBST || PL_lex_inwhat == OP_TRANS)) {
- SvUPGRADE(PL_lex_repl, SVt_PVNV);
- SvNVX(PL_lex_repl) = SvNVX(PL_linestr);
PL_linestr = PL_lex_repl;
PL_lex_inpat = 0;
PL_bufend = PL_bufptr = PL_oldbufptr = PL_oldoldbufptr = PL_linestart = SvPVX(PL_linestr);
PL_bufend += SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
- SAVEFREESV(PL_linestr);
PL_lex_dojoin = FALSE;
PL_lex_brackets = 0;
PL_lex_allbrackets = 0;
#endif
if (min > max) {
+ SvREFCNT_dec(sv);
Perl_croak(aTHX_
"Invalid range \"%c-%c\" in transliteration operator",
(char)min, (char)max);
/* range begins (ignore - as first or last char) */
else if (*s == '-' && s+1 < send && s != start) {
if (didrange) {
+ SvREFCNT_dec(sv);
Perl_croak(aTHX_ "Ambiguous range in transliteration operator");
}
if (has_utf8
}
if (S_is_opval_token(next_type) && pl_yylval.opval)
pl_yylval.opval->op_savefree = 0; /* release */
-#ifdef PERL_MAD
- /* FIXME - can these be merged? */
- return next_type;
-#else
return REPORT(next_type);
-#endif
}
/* interpolated case modifiers like \L \U, including \Q and \E.
}
/* Convert (?{...}) and friends to 'do {...}' */
if (PL_lex_inpat && *PL_bufptr == '(') {
- PL_sublex_info.re_eval_start = PL_bufptr;
+ PL_parser->lex_shared->re_eval_start = PL_bufptr;
PL_bufptr += 2;
if (*PL_bufptr != '{')
PL_bufptr++;
Perl_croak(aTHX_ "Bad evalled substitution pattern");
PL_lex_repl = NULL;
}
- if (PL_sublex_info.re_eval_start) {
+ /* Paranoia. re_eval_start is adjusted when S_scan_heredoc sets
+ re_eval_str. If the here-doc body’s length equals the previous
+ value of re_eval_start, re_eval_start will now be null. So
+ check re_eval_str as well. */
+ if (PL_parser->lex_shared->re_eval_start
+ || PL_parser->lex_shared->re_eval_str) {
+ SV *sv;
if (*PL_bufptr != ')')
Perl_croak(aTHX_ "Sequence (?{...}) not terminated with ')'");
PL_bufptr++;
/* having compiled a (?{..}) expression, return the original
* text too, as a const */
+ if (PL_parser->lex_shared->re_eval_str) {
+ sv = PL_parser->lex_shared->re_eval_str;
+ PL_parser->lex_shared->re_eval_str = NULL;
+ SvCUR_set(sv,
+ PL_bufptr - PL_parser->lex_shared->re_eval_start);
+ SvPV_shrink_to_cur(sv);
+ }
+ else sv = newSVpvn(PL_parser->lex_shared->re_eval_start,
+ PL_bufptr - PL_parser->lex_shared->re_eval_start);
start_force(PL_curforce);
/* XXX probably need a CURMAD(something) here */
NEXTVAL_NEXTTOKE.opval =
(OP*)newSVOP(OP_CONST, 0,
- newSVpvn(PL_sublex_info.re_eval_start,
- PL_bufptr - PL_sublex_info.re_eval_start));
+ sv);
force_next(THING);
- PL_sublex_info.re_eval_start = NULL;
+ PL_parser->lex_shared->re_eval_start = NULL;
PL_expect = XTERM;
return REPORT(',');
}
fake_eof = LEX_FAKE_EOF;
}
PL_bufptr = PL_bufend;
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
if (!lex_next_chunk(fake_eof)) {
CopLINE_dec(PL_curcop);
s = PL_bufptr;
s = scan_heredoc(s);
else
s = scan_inputsymbol(s);
- TERM(sublex_start());
+ PL_expect = XOPERATOR;
+ TOKEN(sublex_start());
}
s++;
{
LOP(OP_SYSWRITE,XTERM);
case KEY_tr:
+ case KEY_y:
s = scan_trans(s);
TERM(sublex_start());
return REPORT(0);
pl_yylval.ival = OP_XOR;
OPERATOR(OROP);
-
- case KEY_y:
- s = scan_trans(s);
- TERM(sublex_start());
}
}}
}
char *e;
char *peek;
const bool infile = PL_rsfp || PL_parser->filtered;
+ LEXSHARED *shared = PL_parser->lex_shared;
#ifdef PERL_MAD
I32 stuffstart = s - SvPVX(PL_linestr);
char *tstart;
SvIV_set(tmpstr, '\\');
}
- CLINE;
- PL_multi_start = CopLINE(PL_curcop);
+ 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
bufptr. See the comments in sublex_push for how IVX and NVX
are abused.
*/
- SV *linestr = NUM2PTR(SV *, SvNVX(PL_linestr));
- char *bufptr = PL_sublex_info.super_bufptr;
- char *bufend = SvEND(linestr);
+ SV *linestr;
+ char *bufptr, *bufend;
char * const olds = s - SvCUR(herewas);
char * const real_olds = s;
- if (!bufptr) {
- s = real_olds;
- goto streaming;
- }
- while (!(s = (char *)memchr((void *)bufptr, '\n', bufend-bufptr))){
- if (SvIVX(linestr)) {
- bufptr = INT2PTR(char *, SvIVX(linestr));
- linestr = NUM2PTR(SV *, SvNVX(linestr));
- bufend = SvEND(linestr);
- }
- else if (infile) {
+ PERL_CONTEXT * const cx = &cxstack[cxstack_ix];
+ do {
+ 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
+ loop in the previous iteration. In an eval, the string buf-
+ fer ends with "\n;", so the while condition below will have
+ evaluated to false. So shared can never be null. */
+ assert(shared);
+ /* A LEXSHARED struct with a null ls_prev pointer is the outer-
+ 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;
goto streaming;
}
- else {
- s = bufend;
- break;
- }
- }
+ } while (!(s = (char *)memchr(
+ (void *)shared->ls_bufptr, '\n',
+ SvEND(shared->ls_linestr)-shared->ls_bufptr
+ )));
+ bufptr = shared->ls_bufptr;
+ linestr = shared->ls_linestr;
+ bufend = SvEND(linestr);
d = s;
while (s < bufend &&
(*s != '\n' || memNE(s,PL_tokenbuf,len)) ) {
if (*s++ == '\n')
- CopLINE_inc(PL_curcop);
+ ++shared->herelines;
}
if (s >= bufend) {
- CopLINE_set(PL_curcop, (line_t)PL_multi_start);
+ 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;
- sv_catpvn(herewas,s,bufend-s);
- Copy(SvPVX_const(herewas),bufptr,SvCUR(herewas) + 1,char);
+ shared->herelines++; /* the preceding stmt passes a newline */
+ /* 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);
+ }
+ Move(s,d,bufend-s + 1,char);
SvCUR_set(linestr,
- bufptr-SvPVX_const(linestr)
- + SvCUR(herewas));
+ SvCUR(linestr) - (s-d));
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')
- CopLINE_inc(PL_curcop);
+ ++shared->herelines;
}
if (s >= PL_bufend) {
- CopLINE_set(PL_curcop, (line_t)PL_multi_start);
+ SvREFCNT_dec(herewas);
+ SvREFCNT_dec(tmpstr);
+ CopLINE_set(PL_curcop, (line_t)PL_multi_start-1);
missingterm(PL_tokenbuf + 1);
}
sv_setpvn(tmpstr,d+1,s-d);
}
#endif
s += len - 1;
- CopLINE_inc(PL_curcop); /* the preceding stmt passes a newline */
+ /* the preceding stmt passes a newline */
+ shared->herelines++;
- sv_catpvn(herewas,s,PL_bufend-s);
- sv_setsv(PL_linestr,herewas);
- PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = s = PL_linestart = SvPVX(PL_linestr);
+ /* s now points to the newline after the heredoc terminator.
+ d points to the newline before the body of the heredoc.
+ */
+ /* 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,
+ PL_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);
+ 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);
- PL_last_lop = PL_last_uni = NULL;
+ s = olds;
}
else
- sv_setpvs(tmpstr,""); /* avoid "uninitialized" warning */
- streaming:
- term = PL_tokenbuf[1];
- len--;
- while (s >= PL_bufend) { /* multiple line string? */
+ {
+ SV *linestr_save;
+ streaming:
+ sv_setpvs(tmpstr,""); /* avoid "uninitialized" warning */
+ term = PL_tokenbuf[1];
+ len--;
+ linestr_save = PL_linestr; /* must restore this afterwards */
+ d = s - SvCUR(herewas) - 1; /* s gets set to this afterwards */
+ PL_linestr = newSVpvs("");
+ PL_bufptr = PL_bufend = s = SvPVX(PL_linestr);
+ while (s >= PL_bufend) { /* multiple line string? */
#ifdef PERL_MAD
if (PL_madskills) {
tstart = SvPVX(PL_linestr) + stuffstart;
}
#endif
PL_bufptr = s;
- CopLINE_inc(PL_curcop);
+ CopLINE_set(PL_curcop,
+ PL_multi_start + shared->herelines);
if (!lex_next_chunk(LEX_NO_TERM)
&& (!SvCUR(tmpstr) || SvEND(tmpstr)[-1] != '\n')) {
- CopLINE_set(PL_curcop, (line_t)PL_multi_start);
+ SvREFCNT_dec(herewas);
+ SvREFCNT_dec(tmpstr);
+ SvREFCNT_dec(linestr_save);
+ CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
missingterm(PL_tokenbuf + 1);
}
- CopLINE_dec(PL_curcop);
+ CopLINE_set(PL_curcop, (line_t)PL_multi_start - 1);
if (!SvCUR(PL_linestr) || PL_bufend[-1] != '\n') {
lex_grow_linestr(SvCUR(PL_linestr) + 2);
sv_catpvs(PL_linestr, "\n\0");
#ifdef PERL_MAD
stuffstart = s - SvPVX(PL_linestr);
#endif
- CopLINE_inc(PL_curcop);
+ shared->herelines++;
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
PL_last_lop = PL_last_uni = NULL;
#ifndef PERL_STRICT_CR
PL_bufend[-1] = '\n';
#endif
if (*s == term && memEQ(s,PL_tokenbuf + 1,len)) {
- STRLEN off = PL_bufend - 1 - SvPVX_const(PL_linestr);
- *(SvPVX(PL_linestr) + off ) = ' ';
- lex_grow_linestr(SvCUR(PL_linestr) + SvCUR(herewas) + 1);
- sv_catsv(PL_linestr,herewas);
+ SvREFCNT_dec(PL_linestr);
+ PL_linestr = linestr_save;
+ PL_linestart = SvPVX(linestr_save);
PL_bufend = SvPVX(PL_linestr) + SvCUR(PL_linestr);
- s = SvPVX(PL_linestr) + off; /* In case PV of PL_linestr moved. */
+ s = d;
}
else {
s = PL_bufend;
sv_catsv(tmpstr,PL_linestr);
}
+ }
}
s++;
retval:
for (; s < ns; s++) {
if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
}
if (!found)
goto read_more_line;
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the current line number */
if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
/* handle quoted delimiters */
if (*s == '\\' && s+1 < PL_bufend && term != '\\') {
if (!keep_quoted
for (; s < PL_bufend; s++,to++) {
/* embedded newlines increment the line count */
if (*s == '\n' && !PL_rsfp && !PL_parser->filtered)
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
/* backslashes can escape the open or closing characters */
if (*s == '\\' && s+1 < PL_bufend) {
if (!keep_quoted &&
PL_thisstuff = newSVpvn(tstart, PL_bufend - tstart);
}
#endif
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
PL_bufptr = PL_bufend;
if (!lex_next_chunk(0)) {
sv_free(sv);
}
#endif
PL_bufptr = PL_bufend;
- CopLINE_inc(PL_curcop);
+ COPLINE_INC_WITH_HERELINES;
got_some = lex_next_chunk(0);
CopLINE_dec(PL_curcop);
s = PL_bufptr;
CvPADLIST(PL_compcv) = pad_new(padnew_SAVE|padnew_SAVESUB);
CvOUTSIDE(PL_compcv) = MUTABLE_CV(SvREFCNT_inc_simple(outsidecv));
CvOUTSIDE_SEQ(PL_compcv) = PL_cop_seqmax;
+ if (outsidecv && CvPADLIST(outsidecv))
+ CvPADLIST(PL_compcv)->xpadl_outid = CvPADLIST(outsidecv)->xpadl_id;
return oldsavestack_ix;
}
https://perl5.git.perl.org / perl5.git / blobdiff