X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=a61a6b30fb3c604fbe9e28ffe475e960a7b317a0;hb=4207d19c588387e70524000ff324caaf2ca59f41;hp=381d1b7c96ae50088bbd228f96b234cb48f1b860;hpb=be25f60935927114e0ef411fb4fbc04fea5ce8fa;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 381d1b7..a61a6b3 100644
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,7 @@
 /*    perly.y
  *
  *    Copyright (c) 1991-2002, 2003, 2004, 2005, 2006 Larry Wall
+ *    Copyright (c) 2007, 2008 by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,8 +10,12 @@
 
 /*
  * 'I see,' laughed Strider.  'I look foul and feel fair.  Is that it?
- * All that is gold does not glitter, not all those who wander are lost.'
+ *  All that is gold does not glitter, not all those who wander are lost.'
  *
+ *     [p.171 of _The Lord of the Rings_, I/x: "Strider"]
+ */
+
+/*
  * This file holds the grammar for the Perl language. If edited, you need
  * to run regen_perly.pl, which re-creates the files perly.h, perly.tab
  * and perly.act which are derived from this.
@@ -68,6 +73,7 @@
 
 %token <opval> WORD METHOD FUNCMETH THING PMFUNC PRIVATEREF
 %token <opval> FUNC0SUB UNIOPSUB LSTOPSUB
+%token <opval> PLUGEXPR PLUGSTMT
 %token <p_tkval> LABEL
 %token <i_tkval> FORMAT SUB ANONSUB PACKAGE USE
 %token <i_tkval> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
@@ -152,7 +158,7 @@ remember:	/* NULL */	/* start a full lexical scope */
 	;
 
 mydefsv:	/* NULL */	/* lexicalize $_ */
-			{ $$ = (I32) allocmy("$_"); }
+			{ $$ = (I32) Perl_allocmy(aTHX_ STR_WITH_LEN("$_"), 0); }
 	;
 
 progstart:
@@ -236,6 +242,8 @@ line	:	label cond
 			      }
 			  })
 			}
+	|	label PLUGSTMT
+			{ $$ = newSTATEOP(0, PVAL($1), $2); }
 	;
 
 /* An expression which may have a side-effect */
@@ -264,6 +272,8 @@ sideff	:	error
 					(OP*)NULL, $3, $1, (OP*)NULL);
 			  TOKEN_GETMAD($2,((LISTOP*)$$)->op_first->op_sibling,'w');
 			}
+	|	expr WHEN expr
+			{ $$ = newWHENOP($3, scope($1)); }
 	;
 
 /* else and elsif blocks */
@@ -322,7 +332,7 @@ cont	:	/* NULL */
 /* Loops: while, until, for, and a bare block */
 loop	:	label WHILE '(' remember texpr ')' mintro mblock cont
 			{ OP *innerop;
-			  PL_parser->copline = (line_t)$2;
+			  PL_parser->copline = (line_t)IVAL($2);
 			    $$ = block_end($4,
 				   newSTATEOP(0, PVAL($1),
 				     innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -335,7 +345,7 @@ loop	:	label WHILE '(' remember texpr ')' mintro mblock cont
 
 	|	label UNTIL '(' remember iexpr ')' mintro mblock cont
 			{ OP *innerop;
-			  PL_parser->copline = (line_t)$2;
+			  PL_parser->copline = (line_t)IVAL($2);
 			    $$ = block_end($4,
 				   newSTATEOP(0, PVAL($1),
 				     innerop = newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
@@ -417,7 +427,7 @@ loop	:	label WHILE '(' remember texpr ')' mintro mblock cont
 
 /* Switch blocks */
 switch	:	label GIVEN '(' remember mydefsv mexpr ')' mblock
-			{ PL_parser->copline = (line_t) $2;
+			{ PL_parser->copline = (line_t) IVAL($2);
 			    $$ = block_end($4,
 				newSTATEOP(0, PVAL($1),
 				    newGIVENOP($6, scope($8),
@@ -501,7 +511,9 @@ peg	:	PEG
 	;
 
 format	:	FORMAT startformsub formname block
-			{ SvREFCNT_inc_simple_void(PL_compcv);
+			{
+			  CV *fmtcv = PL_compcv;
+			  SvREFCNT_inc_simple_void(PL_compcv);
 #ifdef MAD
 			  $$ = newFORM($2, $3, $4);
 			  prepend_madprops($1->tk_mad, $$, 'F');
@@ -511,6 +523,10 @@ format	:	FORMAT startformsub formname block
 			  newFORM($2, $3, $4);
 			  $$ = (OP*)NULL;
 #endif
+			  if (CvOUTSIDE(fmtcv) && !CvUNIQUE(CvOUTSIDE(fmtcv))) {
+			    SvREFCNT_inc_simple_void(fmtcv);
+			    pad_add_anon((SV*)fmtcv, OP_NULL);
+			  }
 			}
 	;
 
@@ -626,14 +642,18 @@ subbody	:	block	{ $$ = $1; }
 			}
 	;
 
-package :	PACKAGE WORD ';'
+package :	PACKAGE WORD WORD ';'
 			{
 #ifdef MAD
-			  $$ = package($2);
+			  $$ = package($3);
 			  token_getmad($1,$$,'o');
-			  token_getmad($3,$$,';');
+			  if ($2)
+			      package_version($2);
+			  token_getmad($4,$$,';');
 #else
-			  package($2);
+			  package($3);
+			  if ($2)
+			      package_version($2);
 			  $$ = (OP*)NULL;
 #endif
 			}
@@ -649,7 +669,7 @@ use	:	USE startsub
 			  token_getmad($7,$$,';');
 			  if (PL_parser->rsfp_filters &&
 				      AvFILLp(PL_parser->rsfp_filters) >= 0)
-			      append_madprops(newMADPROP('!', MAD_PV, "", 0), $$, 0);
+			      append_madprops(newMADPROP('!', MAD_NULL, NULL, 0), $$, 0);
 #else
 			  utilize(IVAL($1), $2, $4, $5, $6);
 			  $$ = (OP*)NULL;
@@ -1231,7 +1251,9 @@ term	:	termbinop
 			{
 			  $$ = newLISTOP(OP_DIE, 0, newOP(OP_PUSHMARK, 0),
 				newSVOP(OP_CONST, 0, newSVpvs("Unimplemented")));
+			  TOKEN_GETMAD($1,$$,'X');
 			}
+	|	PLUGEXPR
 	;
 
 /* "my" declarations, with optional attributes */