X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=edbcb19b36e6fd682630873e8195f19d5db61afa;hb=842c41230043ce99d4bf7b2c79aed85ce2908e89;hp=4e9908e3daf052bc8a07556f68a09e4d4ba3bacf;hpb=d6447115bb9638af823243dbe17f2c14e71cf57d;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 4e9908e..edbcb19 100644
--- a/perly.y
+++ b/perly.y
@@ -92,7 +92,7 @@
 
 %type <opval> decl format subrout mysubrout package use peg
 
-%type <opval> block mblock lineseq line loop cond else
+%type <opval> block package_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 miexpr
 %type <opval> listexpr listexprcom indirob listop method
@@ -242,6 +242,11 @@ line	:	label cond
 			      }
 			  })
 			}
+	|	package_block
+			{ $$ = newSTATEOP(0, NULL,
+				 newWHILEOP(0, 1, (LOOP*)(OP*)NULL,
+					    NOLINE, (OP*)NULL, $1,
+					    (OP*)NULL, 0)); }
 	|	label PLUGSTMT
 			{ $$ = newSTATEOP(0, PVAL($1), $2); }
 	;
@@ -332,7 +337,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,
@@ -345,7 +350,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,
@@ -427,7 +432,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),
@@ -511,7 +516,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');
@@ -521,6 +528,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);
+			  }
 			}
 	;
 
@@ -653,6 +664,31 @@ package :	PACKAGE WORD WORD ';'
 			}
 	;
 
+package_block:	PACKAGE WORD WORD '{' remember
+			{
+			  int save_3_latefree = $3->op_latefree;
+			  $3->op_latefree = 1;
+			  package($3);
+			  $3->op_latefree = save_3_latefree;
+			  if ($2) {
+			      int save_2_latefree = $2->op_latefree;
+			      $2->op_latefree = 1;
+			      package_version($2);
+			      $2->op_latefree = save_2_latefree;
+			  }
+			}
+		    lineseq '}'
+			{ if (PL_parser->copline > (line_t)IVAL($4))
+			      PL_parser->copline = (line_t)IVAL($4);
+			  $$ = block_end($5, $7);
+			  TOKEN_GETMAD($4,$$,'{');
+			  TOKEN_GETMAD($8,$$,'}');
+			  op_free($3);
+			  if ($2)
+			      op_free($2);
+			}
+	;
+
 use	:	USE startsub
 			{ CvSPECIAL_on(PL_compcv); /* It's a BEGIN {} */ }
 		    WORD WORD listexpr ';'