X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=perly.y;h=481a2ccad6626ff8106521fe7209ed5af5bacdcf;hb=49d8d3a1123fb996c090905424ed66f675b3df17;hp=5de74ff650e34e9e4f1aa25f98dd0ce37d03e635;hpb=774d564bb7dd1ed64ca0d7e534aa67e93f991f02;p=p5sagit%2Fp5-mst-13.2.git

diff --git a/perly.y b/perly.y
index 5de74ff..481a2cc 100644
--- a/perly.y
+++ b/perly.y
@@ -1,6 +1,6 @@
 /*    perly.y
  *
- *    Copyright (c) 1991-1994, Larry Wall
+ *    Copyright (c) 1991-1997, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -9,7 +9,7 @@
 
 /*
  * 'I see,' laughed Strider.  'I look foul and feel fair.  Is that it?
- * All that is gold does not glitter, not all those that wander are lost.'
+ * All that is gold does not glitter, not all those who wander are lost.'
  */
 
 %{
@@ -17,7 +17,7 @@
 #include "perl.h"
 
 static void
-dep()
+dep(void)
 {
     deprecate("\"do\" to call subroutines");
 }
@@ -187,13 +187,13 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
-						$5, $7, $8))); }
+						$2, $5, $7, $8))); }
 	|	label UNTIL '(' remember miexpr ')' mblock cont
 			{ copline = $2;
 			    $$ = block_end($4,
 				   newSTATEOP(0, $1,
 				     newWHILEOP(0, 1, (LOOP*)Nullop,
-						$5, $7, $8))); }
+						$2, $5, $7, $8))); }
 	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
 			{ $$ = block_end($4,
 				 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
@@ -206,17 +206,17 @@ loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 				 newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
 	|	label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
 			/* basically fake up an initialize-while lineseq */
-			{ copline = $2;
-			    $$ = block_end($4,
-				   append_elem(OP_LINESEQ, scalar($5),
-				     newSTATEOP(0, $1,
-				       newWHILEOP(0, 1, (LOOP*)Nullop,
-						  scalar($7),
-						  $11, scalar($9))))); }
+			{ OP *forop = append_elem(OP_LINESEQ,
+					scalar($5),
+					newWHILEOP(0, 1, (LOOP*)Nullop,
+						   $2, scalar($7),
+						   $11, scalar($9)));
+			  copline = $2;
+			  $$ = block_end($4, newSTATEOP(0, $1, forop)); }
 	|	label block cont  /* a block is a loop that happens once */
-			{ $$ = newSTATEOP(0,
-				$1, newWHILEOP(0, 1, (LOOP*)Nullop,
-					Nullop, $2, $3)); }
+			{ $$ = newSTATEOP(0, $1,
+				 newWHILEOP(0, 1, (LOOP*)Nullop,
+					    NOLINE, Nullop, $2, $3)); }
 	;
 
 nexpr	:	/* NULL */
@@ -288,8 +288,9 @@ startformsub:	/* NULL */	/* start a format subroutine scope */
 			{ $$ = start_subparse(TRUE, 0); }
 	;
 
-subname	:	WORD	{ char *name = SvPVx(((SVOP*)$1)->op_sv, na);
-			  if (strEQ(name, "BEGIN") || strEQ(name, "END"))
+subname	:	WORD	{ char *name = SvPV(((SVOP*)$1)->op_sv, na);
+			  if (strEQ(name, "BEGIN") || strEQ(name, "END")
+			      || strEQ(name, "INIT"))
 			      CvUNIQUE_on(compcv);
 			  $$ = $1; }
 	;
@@ -529,6 +530,13 @@ term	:	term ASSIGNOP term
 			    prepend_elem(OP_LIST,
 				$4,
 				scalar(newCVREF(0,scalar($2))))); dep();}
+	|	term ARROW '(' ')'	%prec '('
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+				   newCVREF(0, scalar($1))); }
+	|	term ARROW '(' expr ')'	%prec '('
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
+				   append_elem(OP_LIST, $4,
+				       newCVREF(0, scalar($1)))); }
 	|	LOOPEX
 			{ $$ = newOP($1, OPf_SPECIAL);
 			    hints |= HINT_BLOCK_SCOPE; }