X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=1d20b04ce0fc45342e22a659518930b9693942f5;hb=f26f4a2f8b63c72a33468ddeeb9d0337f0892af6;hp=2d989b3a30a046ce3aeeeb2b1ee6ab9f9061a05b;hpb=a758b0b5fd9985d853637e2aa988519329533771;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 2d989b3..1d20b04 100644
--- a/perly.y
+++ b/perly.y
@@ -45,14 +45,14 @@
 %token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
 %token <ival> RELOP EQOP MULOP ADDOP
 %token <ival> DOLSHARP DO HASHBRACK NOAMP
-%token <ival> LOCAL MY MYSUB
+%token <ival> LOCAL MY MYSUB REQUIRE
 %token COLONATTR
 
-%type <ival> prog decl format startsub startanonsub startformsub
+%type <ival> prog decl format startsub startanonsub startformsub mintro
 %type <ival> progstart remember mremember '&' savescope
 %type <opval> block mblock lineseq line loop cond else
 %type <opval> expr term subscripted scalar ary hsh arylen star amper sideff
-%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
+%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr miexpr
 %type <opval> listexpr listexprcom indirob listop method
 %type <opval> formname subname proto subbody cont my_scalar
 %type <opval> subattrlist myattrlist mysubrout myattrterm myterm
@@ -207,18 +207,18 @@ cont	:	/* NULL */
 	;
 
 /* Loops: while, until, for, and a bare block */
-loop	:	label WHILE '(' remember mtexpr ')' mblock cont
+loop	:	label WHILE '(' remember texpr ')' mintro mblock cont
 			{ PL_copline = (line_t)$2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
-						$2, $5, $7, $8))); }
-	|	label UNTIL '(' remember miexpr ')' mblock cont
+						$2, $5, $8, $9, $7))); }
+	|	label UNTIL '(' remember iexpr ')' mintro mblock cont
 			{ PL_copline = (line_t)$2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
-						$2, $5, $7, $8))); }
+						$2, $5, $8, $9, $7))); }
 	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
 			{ $$ = block_end($4,
 				 newFOROP(0, $1, (line_t)$2, $5, $7, $9, $10)); }
@@ -229,14 +229,15 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 	|	label FOR '(' remember mexpr ')' mblock cont
 			{ $$ = block_end($4,
 				 newFOROP(0, $1, (line_t)$2, Nullop, $5, $7, $8)); }
-	|	label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
+	|	label FOR '(' remember mnexpr ';' texpr ';' mintro mnexpr ')'
+	    	    mblock
 			/* basically fake up an initialize-while lineseq */
 			{ OP *forop;
 			  PL_copline = (line_t)$2;
 			  forop = newSTATEOP(0, $1,
 					    newWHILEOP(0, 1, (LOOP*)Nullop,
 						$2, scalar($7),
-						$11, $9));
+						$12, $10, $9));
 			  if ($5) {
 				forop = append_elem(OP_LINESEQ,
                                         newSTATEOP(0, ($1?savepv($1):Nullch),
@@ -248,9 +249,15 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 	|	label block cont  /* a block is a loop that happens once */
 			{ $$ = newSTATEOP(0, $1,
 				 newWHILEOP(0, 1, (LOOP*)Nullop,
-					    NOLINE, Nullop, $2, $3)); }
+					    NOLINE, Nullop, $2, $3, 0)); }
 	;
 
+/* determine whether there are any new my declarations */
+mintro	:	/* NULL */
+			{ $$ = (PL_min_intro_pending &&
+			    PL_max_intro_pending >=  PL_min_intro_pending);
+			  intro_my(); }
+
 /* Normal expression */
 nexpr	:	/* NULL */
 			{ $$ = Nullop; }
@@ -277,10 +284,6 @@ mnexpr	:	nexpr
 			{ $$ = $1; intro_my(); }
 	;
 
-mtexpr	:	texpr
-			{ $$ = $1; intro_my(); }
-	;
-
 miexpr	:	iexpr
 			{ $$ = $1; intro_my(); }
 	;
@@ -335,7 +338,7 @@ startformsub:	/* NULL */	/* start a format subroutine scope */
 	;
 
 /* Name of a subroutine - must be a bareword, could be special */
-subname	:	WORD	{ STRLEN n_a; char *name = SvPV(((SVOP*)$1)->op_sv,n_a);
+subname	:	WORD	{ const char *const name = SvPV_nolen_const(((SVOP*)$1)->op_sv);
 			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
 			      || strEQ(name, "INIT") || strEQ(name, "CHECK"))
 			      CvSPECIAL_on(PL_compcv);
@@ -484,6 +487,10 @@ subscripted:    star '{' expr ';' '}'        /* *main::{something} */
 	|	subscripted '(' ')'        /* $foo->{bar}->() */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				   newCVREF(0, scalar($1))); }
+	|	'(' expr ')' '[' expr ']'            /* list slice */
+			{ $$ = newSLICEOP(0, $5, $2); }
+	|	'(' ')' '[' expr ']'                 /* empty list slice! */
+			{ $$ = newSLICEOP(0, $4, Nullop); }
     ;
 
 /* Binary operators between terms */
@@ -559,7 +566,7 @@ anonymous:	'[' expr ']'
 
 /* Things called with "do" */
 termdo	:       DO term	%prec UNIOP                     /* do $filename */
-			{ $$ = dofile($2); }
+			{ $$ = dofile($2, $1); }
 	|	DO block	%prec '('               /* do { code */
 			{ $$ = newUNOP(OP_NULL, OPf_SPECIAL, scope($2)); }
 	|	DO WORD '(' ')'                         /* do somesub() */
@@ -619,10 +626,6 @@ term	:	termbinop
 			{ $$ = newUNOP(OP_AV2ARYLEN, 0, ref($1, OP_AV2ARYLEN));}
 	|       subscripted
 			{ $$ = $1; }
-	|	'(' expr ')' '[' expr ']'            /* list slice */
-			{ $$ = newSLICEOP(0, $5, $2); }
-	|	'(' ')' '[' expr ']'                 /* empty list slice! */
-			{ $$ = newSLICEOP(0, $4, Nullop); }
 	|	ary '[' expr ']'                     /* array slice */
 			{ $$ = prepend_elem(OP_ASLICE,
 				newOP(OP_PUSHMARK, 0),
@@ -661,6 +664,10 @@ term	:	termbinop
 			{ $$ = newUNOP($1, 0, $2); }
 	|	UNIOP term                           /* Unary op */
 			{ $$ = newUNOP($1, 0, $2); }
+	|	REQUIRE                              /* require, $_ implied */
+			{ $$ = newOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0); }
+	|	REQUIRE term                         /* require Foo */
+			{ $$ = newUNOP(OP_REQUIRE, $1 ? OPf_SPECIAL : 0, $2); }
 	|	UNIOPSUB term                        /* Sub treated as unop */
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 			    append_elem(OP_LIST, $2, scalar($1))); }