perl 5.004_04

1 files changed, 145 insertions, 85 deletions

diff --git a/gnu/usr.bin/perl/perly.y b/gnu/usr.bin/perl/perly.y
index 96a35e1c0ec..6313061934f 100644
--- a/gnu/usr.bin/perl/perly.y
+++ b/gnu/usr.bin/perl/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.'
  */
 
 %{
@@ -41,22 +41,24 @@ dep()
 %token <ival> FORMAT SUB ANONSUB PACKAGE USE
 %token <ival> WHILE UNTIL IF UNLESS ELSE ELSIF CONTINUE FOR
 %token <ival> LOOPEX DOTDOT
-%token <ival> FUNC0 FUNC1 FUNC
+%token <ival> FUNC0 FUNC1 FUNC UNIOP LSTOP
 %token <ival> RELOP EQOP MULOP ADDOP
-%token <ival> DOLSHARP DO LOCAL HASHBRACK NOAMP
+%token <ival> DOLSHARP DO HASHBRACK NOAMP
+%token LOCAL MY
 
-%type <ival> prog decl format remember startsub '&'
-%type <opval> block lineseq line loop cond nexpr else argexpr
+%type <ival> prog decl local format startsub startanonsub startformsub
+%type <ival> remember mremember '&'
+%type <opval> block mblock lineseq line loop cond else
 %type <opval> expr term scalar ary hsh arylen star amper sideff
-%type <opval> listexpr listexprcom indirob
-%type <opval> texpr listop method proto
+%type <opval> argexpr nexpr texpr iexpr mexpr mnexpr mtexpr miexpr
+%type <opval> listexpr listexprcom indirob listop method
+%type <opval> formname subname proto subbody cont my_scalar
 %type <pval> label
-%type <opval> cont
 
 %left <ival> OROP
 %left ANDOP
 %right NOTOP
-%nonassoc <ival> LSTOP
+%nonassoc LSTOP LSTOPSUB
 %left ','
 %right <ival> ASSIGNOP
 %right '?' ':'
@@ -67,7 +69,7 @@ dep()
 %left <ival> BITANDOP
 %nonassoc EQOP
 %nonassoc RELOP
-%nonassoc <ival> UNIOP
+%nonassoc UNIOP UNIOPSUB
 %left <ival> SHIFTOP
 %left ADDOP
 %left MULOP
@@ -92,11 +94,23 @@ prog	:	/* NULL */
 	;
 
 block	:	'{' remember lineseq '}'
-			{ $$ = block_end($1,$2,$3); }
+			{ if (copline > (line_t)$1)
+			      copline = $1;
+			  $$ = block_end($2, $3); }
 	;
 
-remember:	/* NULL */	/* start a lexical scope */
-			{ $$ = block_start(); }
+remember:	/* NULL */	/* start a full lexical scope */
+			{ $$ = block_start(TRUE); }
+	;
+
+mblock	:	'{' mremember lineseq '}'
+			{ if (copline > (line_t)$1)
+			      copline = $1;
+			  $$ = block_end($2, $3); }
+	;
+
+mremember:	/* NULL */	/* start a partial lexical scope */
+			{ $$ = block_start(FALSE); }
 	;
 
 lineseq	:	/* NULL */
@@ -137,37 +151,29 @@ sideff	:	error
 			{ $$ = newLOGOP(OP_OR, 0, $3, $1); }
 	|	expr WHILE expr
 			{ $$ = newLOOPOP(OPf_PARENS, 1, scalar($3), $1); }
-	|	expr UNTIL expr
-			{ $$ = newLOOPOP(OPf_PARENS, 1, invert(scalar($3)), $1);}
+	|	expr UNTIL iexpr
+			{ $$ = newLOOPOP(OPf_PARENS, 1, $3, $1);}
 	;
 
 else	:	/* NULL */
 			{ $$ = Nullop; }
-	|	ELSE block
+	|	ELSE mblock
 			{ $$ = scope($2); }
-	|	ELSIF '(' expr ')' block else
+	|	ELSIF '(' mexpr ')' mblock else
 			{ copline = $1;
-			    $$ = newSTATEOP(0, 0,
-				newCONDOP(0, $3, scope($5), $6));
+			    $$ = newSTATEOP(0, Nullch,
+				   newCONDOP(0, $3, scope($5), $6));
 			    hints |= HINT_BLOCK_SCOPE; }
 	;
 
-cond	:	IF '(' expr ')' block else
-			{ copline = $1;
-			    $$ = newCONDOP(0, $3, scope($5), $6); }
-	|	UNLESS '(' expr ')' block else
+cond	:	IF '(' remember mexpr ')' mblock else
 			{ copline = $1;
-			    $$ = newCONDOP(0,
-				invert(scalar($3)), scope($5), $6); }
-	|	IF block block else
+			    $$ = block_end($3,
+				   newCONDOP(0, $4, scope($6), $7)); }
+	|	UNLESS '(' remember miexpr ')' mblock else
 			{ copline = $1;
-			    deprecate("if BLOCK BLOCK");
-			    $$ = newCONDOP(0, scope($2), scope($3), $4); }
-	|	UNLESS block block else
-			{ copline = $1;
-			    deprecate("unless BLOCK BLOCK");
-			    $$ = newCONDOP(0, invert(scalar(scope($2))),
-						scope($3), $4); }
+			    $$ = block_end($3,
+				   newCONDOP(0, $4, scope($6), $7)); }
 	;
 
 cont	:	/* NULL */
@@ -176,43 +182,41 @@ cont	:	/* NULL */
 			{ $$ = scope($2); }
 	;
 
-loop	:	label WHILE '(' texpr ')' block cont
-			{ copline = $2;
-			    $$ = newSTATEOP(0, $1,
-				    newWHILEOP(0, 1, (LOOP*)Nullop,
-					$4, $6, $7) ); }
-	|	label UNTIL '(' expr ')' block cont
-			{ copline = $2;
-			    $$ = newSTATEOP(0, $1,
-				    newWHILEOP(0, 1, (LOOP*)Nullop,
-					invert(scalar($4)), $6, $7) ); }
-	|	label WHILE block block cont
+loop	:	label WHILE '(' remember mtexpr ')' mblock cont
 			{ copline = $2;
-			    $$ = newSTATEOP(0, $1,
-				    newWHILEOP(0, 1, (LOOP*)Nullop,
-					scope($3), $4, $5) ); }
-	|	label UNTIL block block cont
+			    $$ = block_end($4,
+				   newSTATEOP(0, $1,
+				     newWHILEOP(0, 1, (LOOP*)Nullop,
+						$2, $5, $7, $8))); }
+	|	label UNTIL '(' remember miexpr ')' mblock cont
 			{ copline = $2;
-			    $$ = newSTATEOP(0, $1,
-				    newWHILEOP(0, 1, (LOOP*)Nullop,
-					invert(scalar(scope($3))), $4, $5)); }
-	|	label FOR scalar '(' expr ')' block cont
-			{ $$ = newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
-				$5, $7, $8); }
-	|	label FOR '(' expr ')' block cont
-			{ $$ = newFOROP(0, $1, $2, Nullop, $4, $6, $7); }
-	|	label FOR '(' nexpr ';' texpr ';' nexpr ')' block
+			    $$ = block_end($4,
+				   newSTATEOP(0, $1,
+				     newWHILEOP(0, 1, (LOOP*)Nullop,
+						$2, $5, $7, $8))); }
+	|	label FOR MY remember my_scalar '(' mexpr ')' mblock cont
+			{ $$ = block_end($4,
+				 newFOROP(0, $1, $2, $5, $7, $9, $10)); }
+	|	label FOR scalar '(' remember mexpr ')' mblock cont
+			{ $$ = block_end($5,
+				 newFOROP(0, $1, $2, mod($3, OP_ENTERLOOP),
+					  $6, $8, $9)); }
+	|	label FOR '(' remember mexpr ')' mblock cont
+			{ $$ = block_end($4,
+				 newFOROP(0, $1, $2, Nullop, $5, $7, $8)); }
+	|	label FOR '(' remember mnexpr ';' mtexpr ';' mnexpr ')' mblock
 			/* basically fake up an initialize-while lineseq */
-			{  copline = $2;
-			    $$ = append_elem(OP_LINESEQ,
-				    newSTATEOP(0, $1, scalar($4)),
-				    newSTATEOP(0, $1,
+			{ OP *forop = append_elem(OP_LINESEQ,
+					scalar($5),
 					newWHILEOP(0, 1, (LOOP*)Nullop,
-					    scalar($6), $10, scalar($8)) )); }
+						   $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 */
@@ -225,6 +229,26 @@ texpr	:	/* NULL means true */
 	|	expr
 	;
 
+iexpr	:	expr
+			{ $$ = invert(scalar($1)); }
+	;
+
+mexpr	:	expr
+			{ $$ = $1; intro_my(); }
+	;
+
+mnexpr	:	nexpr
+			{ $$ = $1; intro_my(); }
+	;
+
+mtexpr	:	texpr
+			{ $$ = $1; intro_my(); }
+	;
+
+miexpr	:	iexpr
+			{ $$ = $1; intro_my(); }
+	;
+
 label	:	/* empty */
 			{ $$ = Nullch; }
 	|	LABEL
@@ -240,25 +264,43 @@ decl	:	format
 			{ $$ = 0; }
 	;
 
-format	:	FORMAT startsub WORD block
+format	:	FORMAT startformsub formname block
 			{ newFORM($2, $3, $4); }
-	|	FORMAT startsub block
-			{ newFORM($2, Nullop, $3); }
 	;
 
-subrout	:	SUB startsub WORD proto block
+formname:	WORD		{ $$ = $1; }
+	|	/* NULL */	{ $$ = Nullop; }
+	;
+
+subrout	:	SUB startsub subname proto subbody
 			{ newSUB($2, $3, $4, $5); }
-	|	SUB startsub WORD proto ';'
-			{ newSUB($2, $3, $4, Nullop); expect = XSTATE; }
+	;
+
+startsub:	/* NULL */	/* start a regular subroutine scope */
+			{ $$ = start_subparse(FALSE, 0); }
+	;
+
+startanonsub:	/* NULL */	/* start an anonymous subroutine scope */
+			{ $$ = start_subparse(FALSE, CVf_ANON); }
+	;
+
+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"))
+			      CvUNIQUE_on(compcv);
+			  $$ = $1; }
 	;
 
 proto	:	/* NULL */
 			{ $$ = Nullop; }
 	|	THING
 	;
-		
-startsub:	/* NULL */	/* start a subroutine scope */
-			{ $$ = start_subparse(); }
+
+subbody	:	block	{ $$ = $1; }
+	|	';'	{ $$ = Nullop; expect = XSTATE; }
 	;
 
 package :	PACKAGE WORD ';'
@@ -267,8 +309,10 @@ package :	PACKAGE WORD ';'
 			{ package(Nullop); }
 	;
 
-use	:	USE startsub WORD listexpr ';'
-			{ utilize($1, $2, $3, $4); }
+use	:	USE startsub
+			{ CvUNIQUE_on(compcv); /* It's a BEGIN {} */ }
+		    WORD WORD listexpr ';'
+			{ utilize($1, $2, $4, $5, $6); }
 	;
 
 expr	:	expr ANDOP expr
@@ -294,7 +338,7 @@ listop	:	LSTOP indirob argexpr
 	|	term ARROW method '(' listexprcom ')'
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
 				append_elem(OP_LIST,
-				    prepend_elem(OP_LIST, $1, $5),
+				    prepend_elem(OP_LIST, scalar($1), $5),
 				    newUNOP(OP_METHOD, 0, $3))); }
 	|	METHOD indirob listexpr
 			{ $$ = convert(OP_ENTERSUB, OPf_STACKED,
@@ -310,11 +354,12 @@ listop	:	LSTOP indirob argexpr
 			{ $$ = convert($1, 0, $2); }
 	|	FUNC '(' listexprcom ')'
 			{ $$ = convert($1, 0, $3); }
-	|	LSTOPSUB startsub block listexpr	%prec LSTOP
+	|	LSTOPSUB startanonsub block
+			{ $3 = newANONSUB($2, 0, $3); }
+		    listexpr		%prec LSTOP
 			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
-			    append_elem(OP_LIST,
-			      prepend_elem(OP_LIST, newANONSUB($2, 0, $3), $4),
-			      $1)); }
+				 append_elem(OP_LIST,
+				   prepend_elem(OP_LIST, $3, $5), $1)); }
 	;
 
 method	:	METHOD
@@ -374,7 +419,7 @@ term	:	term ASSIGNOP term
 	|	PREDEC term
 			{ $$ = newUNOP(OP_PREDEC, 0,
 					mod(scalar($2), OP_PREDEC)); }
-	|	LOCAL term	%prec UNIOP
+	|	local term	%prec UNIOP
 			{ $$ = localize($2,$1); }
 	|	'(' expr ')'
 			{ $$ = sawparens($2); }
@@ -388,7 +433,7 @@ term	:	term ASSIGNOP term
 			{ $$ = newANONHASH($2); }
 	|	HASHBRACK ';' '}'				%prec '('
 			{ $$ = newANONHASH(Nullop); }
-	|	ANONSUB startsub proto block			%prec '('
+	|	ANONSUB startanonsub proto block		%prec '('
 			{ $$ = newANONSUB($2, $3, $4); }
 	|	scalar	%prec '('
 			{ $$ = $1; }
@@ -484,6 +529,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; }
@@ -505,7 +557,7 @@ term	:	term ASSIGNOP term
 	|	FUNC0 '(' ')'
 			{ $$ = newOP($1, 0); }
 	|	FUNC0SUB
-			{ $$ = newUNOP(OP_ENTERSUB, 0,
+			{ $$ = newUNOP(OP_ENTERSUB, OPf_STACKED,
 				scalar($1)); }
 	|	FUNC1 '(' ')'
 			{ $$ = newOP($1, OPf_SPECIAL); }
@@ -533,6 +585,14 @@ listexprcom:	/* NULL */
 			{ $$ = $1; }
 	;
 
+local	:	LOCAL	{ $$ = 0; }
+	|	MY	{ $$ = 1; }
+	;
+
+my_scalar:	scalar
+			{ in_my = 0; $$ = my($1); }
+	;
+
 amper	:	'&' indirob
 			{ $$ = newCVREF($1,$2); }
 	;