foreach \$var

Some passing tests are still marked to-do.  We need more tests still.

1 files changed, 36 insertions, 1 deletions

diff --git a/perly.y b/perly.y
index fcb9ec0aa7..a90943611c 100644
--- a/perly.y
+++ b/perly.y
@@ -71,7 +71,8 @@
 %type <opval> sliceme kvslice gelem
 %type <opval> listexpr nexpr texpr iexpr mexpr mnexpr miexpr
 %type <opval> optlistexpr optexpr indirob listop method
-%type <opval> formname subname proto optsubbody cont my_scalar formblock
+%type <opval> formname subname proto optsubbody cont my_scalar my_var
+%type <opval> refgen_topic formblock
 %type <opval> subattrlist myattrlist myattrterm myterm
 %type <opval> realsubbody subsignature termbinop termunop anonymous termdo
 %type <opval> formstmtseq formline formarg
@@ -378,6 +379,31 @@ barestmt:	PLUGSTMT
 				      op_lvalue($2, OP_ENTERLOOP), $5, $7, $8));
 			  parser->copline = (line_t)$1;
 			}
+	|	FOR REFGEN MY remember my_var
+			{ parser->in_my = 0; $<opval>$ = my($5); }
+		'(' mexpr ')' mblock cont
+			{
+			  $$ = block_end(
+				$4,
+				newFOROP(0,
+					 op_lvalue(
+					    newUNOP(OP_REFGEN, 0,
+						    op_lvalue($<opval>6,
+							      OP_REFGEN)),
+					    OP_ENTERLOOP),
+					 $8, $10, $11)
+			  );
+			  parser->copline = (line_t)$1;
+			}
+	|	FOR REFGEN refgen_topic '(' remember mexpr ')' mblock cont
+			{
+			  $$ = block_end($5, newFOROP(
+				0, op_lvalue(newUNOP(OP_REFGEN, 0,
+						     op_lvalue($3,
+							       OP_REFGEN)),
+					     OP_ENTERLOOP), $6, $8, $9));
+			  parser->copline = (line_t)$1;
+			}
 	|	FOR '(' remember mexpr ')' mblock cont
 			{
 			  $$ = block_end($3,
@@ -1018,6 +1044,15 @@ my_scalar:	scalar
 			{ parser->in_my = 0; $$ = my($1); }
 	;
 
+my_var	:	scalar
+	|	ary
+	|	hsh
+	;
+
+refgen_topic:	my_var
+	|	amper
+	;
+
 amper	:	'&' indirob
 			{ $$ = newCVREF($1,$2); }
 	;