X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=toke.c;h=e84e18cadd31c1d06822de92cc3b72e8a22cdfaf;hb=a9277f440b7800bab095ac55322c223f4308cd3e;hp=9726a31b717a921073f14776353face056c809ca;hpb=bc177e6b66d4907a90c81f2862ce55ad78b6496f;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/toke.c b/toke.c
index 9726a31..e84e18c 100644
--- a/toke.c
+++ b/toke.c
@@ -61,6 +61,13 @@
 #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)
@@ -90,7 +97,6 @@ S_pending_ident(pTHX);
 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);
@@ -634,21 +640,30 @@ S_cr_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);
@@ -661,20 +676,22 @@ Perl_lex_start(pTHX_ SV *line)
 
     /* on scope exit, free this parser and restore any outer one */
     SAVEPARSER(parser);
+    parser->saved_curcop = PL_curcop;
 
     /* initialise lexer state */
 
-    SAVECOPLINE(PL_curcop);
-    SAVEDESTRUCTOR_X(restore_rsfp, PL_rsfp);
-
 #ifdef PERL_MAD
     parser->curforce = -1;
 #else
     parser->nexttoke = 0;
 #endif
     parser->copline = NOLINE;
-    PL_lex_state = LEX_NORMAL;
+    parser->lex_state = LEX_NORMAL;
     parser->expect = XSTATE;
+    parser->rsfp = rsfp;
+    parser->rsfp_filters = (new_filter || !oparser) ? newAV()
+		: (AV*)SvREFCNT_inc(oparser->rsfp_filters);
+
     Newx(parser->lex_brackstack, 120, char);
     Newx(parser->lex_casestack, 12, char);
     *parser->lex_casestack = '\0';
@@ -702,7 +719,6 @@ Perl_lex_start(pTHX_ SV *line)
 	parser->linestart = SvPVX(parser->linestr);
     parser->bufend = parser->bufptr + SvCUR(parser->linestr);
     parser->last_lop = parser->last_uni = NULL;
-    PL_rsfp = 0;
 }
 
 
@@ -711,8 +727,16 @@ Perl_lex_start(pTHX_ SV *line)
 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);
@@ -1258,7 +1282,7 @@ S_curmad(pTHX_ char slot, SV *sv)
     /* 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
@@ -2757,6 +2781,9 @@ Perl_filter_add(pTHX_ filter_t funcp, SV *datasv)
     if (!funcp)
 	return NULL;
 
+    if (!PL_parser)
+	return NULL;
+
     if (!PL_rsfp_filters)
 	PL_rsfp_filters = newAV();
     if (!datasv)
@@ -2784,7 +2811,7 @@ Perl_filter_del(pTHX_ filter_t funcp)
     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));
@@ -2820,7 +2847,7 @@ Perl_filter_read(pTHX_ int idx, SV *buf_sv, int maxlen)
 #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.	*/
@@ -4269,10 +4296,6 @@ Perl_yylex(pTHX)
 			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
@@ -4367,7 +4390,9 @@ Perl_yylex(pTHX)
 	    --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;
 	    }
 	}
@@ -5405,18 +5430,7 @@ Perl_yylex(pTHX)
 			    d++;
 			if (*d == ')' && (sv = gv_const_sv(gv))) {
 			    s = d + 1;
-#ifdef PERL_MAD
-			    if (PL_madskills) {
-				char *par = SvPVX(PL_linestr) + PL_realtokenstart; 
-				sv_catpvn(PL_thistoken, par, s - par);
-				if (PL_nextwhite) {
-				    sv_free(PL_nextwhite);
-				    PL_nextwhite = 0;
-				}
-			    }
-			    else
-#endif
-				goto its_constant;
+			    goto its_constant;
 			}
 		    }
 #ifdef PERL_MAD
@@ -5463,7 +5477,7 @@ Perl_yylex(pTHX)
 				"Ambiguous use of -%s resolved as -&%s()",
 				PL_tokenbuf, PL_tokenbuf);
 		    /* Check for a constant sub */
-		    if ((sv = gv_const_sv(gv)) && !PL_madskills) {
+		    if ((sv = gv_const_sv(gv))) {
 		  its_constant:
 			SvREFCNT_dec(((SVOP*)yylval.opval)->op_sv);
 			((SVOP*)yylval.opval)->op_sv = SvREFCNT_inc_simple(sv);
@@ -12659,23 +12673,6 @@ S_swallow_bom(pTHX_ U8 *s)
     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