#define PL_preambled (PL_parser->preambled)
#define PL_sublex_info (PL_parser->sublex_info)
#define PL_linestr (PL_parser->linestr)
-
+#define PL_expect (PL_parser->expect)
+#define PL_copline (PL_parser->copline)
+#define PL_bufptr (PL_parser->bufptr)
+#define PL_oldbufptr (PL_parser->oldbufptr)
+#define PL_oldoldbufptr (PL_parser->oldoldbufptr)
+#define PL_linestart (PL_parser->linestart)
+#define PL_bufend (PL_parser->bufend)
+#define PL_last_uni (PL_parser->last_uni)
+#define PL_last_lop (PL_parser->last_lop)
+#define PL_last_lop_op (PL_parser->last_lop_op)
+#define PL_lex_state (PL_parser->lex_state)
+#define PL_rsfp (PL_parser->rsfp)
+#define PL_rsfp_filters (PL_parser->rsfp_filters)
+#define PL_in_my (PL_parser->in_my)
+#define PL_in_my_stash (PL_parser->in_my_stash)
+#define PL_tokenbuf (PL_parser->tokenbuf)
+#define PL_multi_end (PL_parser->multi_end)
+#define PL_error_count (PL_parser->error_count)
#ifdef PERL_MAD
# define PL_endwhite (PL_parser->endwhite)
# define PL_thisstuff (PL_parser->thisstuff)
# define PL_thistoken (PL_parser->thistoken)
# define PL_thiswhite (PL_parser->thiswhite)
+# define PL_thiswhite (PL_parser->thiswhite)
+# define PL_nexttoke (PL_parser->nexttoke)
+# define PL_curforce (PL_parser->curforce)
+#else
+# define PL_nexttoke (PL_parser->nexttoke)
+# define PL_nexttype (PL_parser->nexttype)
+# define PL_nextval (PL_parser->nextval)
#endif
static int
static const char ident_too_long[] = "Identifier too long";
static const char commaless_variable_list[] = "comma-less variable list";
-static void restore_rsfp(pTHX_ void *f);
#ifndef PERL_NO_UTF16_FILTER
static I32 utf16_textfilter(pTHX_ int idx, SV *sv, int maxlen);
static I32 utf16rev_textfilter(pTHX_ int idx, SV *sv, int maxlen);
/*
* Perl_lex_start
+ *
* Create a parser object and initialise its parser and lexer fields
+ *
+ * rsfp is the opened file handle to read from (if any),
+ *
+ * line holds any initial content already read from the file (or in
+ * the case of no file, such as an eval, the whole contents);
+ *
+ * new_filter indicates that this is a new file and it shouldn't inherit
+ * the filters from the current parser (ie require).
*/
void
-Perl_lex_start(pTHX_ SV *line)
+Perl_lex_start(pTHX_ SV *line, PerlIO *rsfp, bool new_filter)
{
dVAR;
const char *s = NULL;
STRLEN len;
- yy_parser *parser;
+ yy_parser *parser, *oparser;
/* create and initialise a parser */
Newxz(parser, 1, yy_parser);
- parser->old_parser = PL_parser;
+ parser->old_parser = oparser = PL_parser;
PL_parser = parser;
Newx(parser->stack, YYINITDEPTH, yy_stack_frame);
/* on scope exit, free this parser and restore any outer one */
SAVEPARSER(parser);
+ parser->saved_curcop = PL_curcop;
/* initialise lexer state */
- SAVEI8(PL_lex_state);
#ifdef PERL_MAD
- if (PL_lex_state == LEX_KNOWNEXT) {
- I32 toke = parser->old_parser->lasttoke;
- while (--toke >= 0) {
- SAVEI32(PL_nexttoke[toke].next_type);
- SAVEVPTR(PL_nexttoke[toke].next_val);
- if (PL_madskills)
- SAVEVPTR(PL_nexttoke[toke].next_mad);
- }
- }
- SAVEI32(PL_curforce);
- PL_curforce = -1;
+ parser->curforce = -1;
#else
- if (PL_lex_state == LEX_KNOWNEXT) {
- I32 toke = PL_nexttoke;
- while (--toke >= 0) {
- SAVEI32(PL_nexttype[toke]);
- SAVEVPTR(PL_nextval[toke]);
- }
- SAVEI32(PL_nexttoke);
- }
+ parser->nexttoke = 0;
#endif
- SAVECOPLINE(PL_curcop);
- SAVEPPTR(PL_bufptr);
- SAVEPPTR(PL_bufend);
- SAVEPPTR(PL_oldbufptr);
- SAVEPPTR(PL_oldoldbufptr);
- SAVEPPTR(PL_last_lop);
- SAVEPPTR(PL_last_uni);
- SAVEPPTR(PL_linestart);
- SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
- SAVEI8(PL_expect);
+ parser->copline = NOLINE;
+ parser->lex_state = LEX_NORMAL;
+ parser->expect = XSTATE;
+ parser->rsfp = rsfp;
+ parser->rsfp_filters = (new_filter || !oparser) ? newAV()
+ : (AV*)SvREFCNT_inc(oparser->rsfp_filters);
- PL_copline = NOLINE;
- PL_lex_state = LEX_NORMAL;
- PL_expect = XSTATE;
Newx(parser->lex_brackstack, 120, char);
Newx(parser->lex_casestack, 12, char);
*parser->lex_casestack = '\0';
-#ifndef PERL_MAD
- PL_nexttoke = 0;
-#endif
if (line) {
s = SvPV_const(line, len);
SvREFCNT_inc_simple_void_NN(line);
parser->linestr = line;
}
- PL_oldoldbufptr = PL_oldbufptr = PL_bufptr = PL_linestart = SvPVX(parser->linestr);
- PL_bufend = PL_bufptr + SvCUR(parser->linestr);
- PL_last_lop = PL_last_uni = NULL;
- PL_rsfp = 0;
+ parser->oldoldbufptr =
+ parser->oldbufptr =
+ parser->bufptr =
+ parser->linestart = SvPVX(parser->linestr);
+ parser->bufend = parser->bufptr + SvCUR(parser->linestr);
+ parser->last_lop = parser->last_uni = NULL;
}
void
Perl_parser_free(pTHX_ const yy_parser *parser)
{
+ PL_curcop = parser->saved_curcop;
SvREFCNT_dec(parser->linestr);
+ if (parser->rsfp == PerlIO_stdin())
+ PerlIO_clearerr(parser->rsfp);
+ else if (parser->rsfp && parser->old_parser
+ && parser->rsfp != parser->old_parser->rsfp)
+ PerlIO_close(parser->rsfp);
+ SvREFCNT_dec(parser->rsfp_filters);
+
Safefree(parser->stack);
Safefree(parser->lex_brackstack);
Safefree(parser->lex_casestack);
/* keep a slot open for the head of the list? */
if (slot != '_' && *where && (*where)->mad_key == '^') {
(*where)->mad_key = slot;
- sv_free((*where)->mad_val);
+ sv_free((SV*)((*where)->mad_val));
(*where)->mad_val = (void*)sv;
}
else
if (!funcp)
return NULL;
+ if (!PL_parser)
+ return NULL;
+
if (!PL_rsfp_filters)
PL_rsfp_filters = newAV();
if (!datasv)
DEBUG_P(PerlIO_printf(Perl_debug_log, "filter_del func %p",
FPTR2DPTR(void*, funcp)));
#endif
- if (!PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
+ if (!PL_parser || !PL_rsfp_filters || AvFILLp(PL_rsfp_filters)<0)
return;
/* if filter is on top of stack (usual case) just pop it off */
datasv = FILTER_DATA(AvFILLp(PL_rsfp_filters));
#endif
: maxlen;
- if (!PL_rsfp_filters)
+ if (!PL_parser || !PL_rsfp_filters)
return -1;
if (idx > AvFILLp(PL_rsfp_filters)) { /* Any more filters? */
/* Provide a default input filter to make life easy. */
sv_free(sv);
CvMETHOD_on(PL_compcv);
}
- else if (!PL_in_my && len == 9 && strnEQ(SvPVX(sv), "assertion", len)) {
- sv_free(sv);
- CvASSERTION_on(PL_compcv);
- }
/* After we've set the flags, it could be argued that
we don't need to do the attributes.pm-based setting
process, and shouldn't bother appending recognized
--PL_lex_brackets;
if (PL_lex_state == LEX_INTERPNORMAL) {
if (PL_lex_brackets == 0) {
- if (*s != '[' && *s != '{' && (*s != '-' || s[1] != '>'))
+ if (*s == '-' && s[1] == '>')
+ PL_lex_state = LEX_INTERPENDMAYBE;
+ else if (*s != '[' && *s != '{')
PL_lex_state = LEX_INTERPEND;
}
}
}
else if (gv && !gvp
&& -tmp==KEY_lock /* XXX generalizable kludge */
- && GvCVu(gv)
- && !hv_fetchs(GvHVn(PL_incgv), "Thread.pm", FALSE))
+ && GvCVu(gv))
{
tmp = 0; /* any sub overrides "weak" keyword */
}
return (char*)s;
}
-/*
- * restore_rsfp
- * Restore a source filter.
- */
-
-static void
-restore_rsfp(pTHX_ void *f)
-{
- dVAR;
- PerlIO * const fp = (PerlIO*)f;
-
- if (PL_rsfp == PerlIO_stdin())
- PerlIO_clearerr(PL_rsfp);
- else if (PL_rsfp && (PL_rsfp != fp))
- PerlIO_close(PL_rsfp);
- PL_rsfp = fp;
-}
#ifndef PERL_NO_UTF16_FILTER
static I32
https://perl5.git.perl.org / perl5.git / blobdiff