From: Rafael Garcia-Suarez <rgs@consttype.org>
Date: Wed, 28 Oct 2009 09:44:31 +0000 (+0100)
Subject: $#array should be accepted as a lvalue sub return value.
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=28c5b5bcd7f52e6b2219508a1066cd0ccc8dd19a;p=p5sagit%2Fp5-mst-13.2.git

$#array should be accepted as a lvalue sub return value.

The OPpMAYBE_LVSUB flag wasn't set for OP_AV2ARYLEN, but the
new implementation of pp_av2arylen introduced by the previous
patch was relying on it. So, now, set this flag. Also add tests for
STORESIZE.
---

diff --git a/op.c b/op.c
index 8741337..d7a5234 100644
--- a/op.c
+++ b/op.c
@@ -1540,12 +1540,17 @@ Perl_mod(pTHX_ OP *o, I32 type)
     case OP_DBSTATE:
        PL_modcount = RETURN_UNLIMITED_NUMBER;
 	break;
+    case OP_AV2ARYLEN:
+	PL_hints |= HINT_BLOCK_SCOPE;
+	if (type == OP_LEAVESUBLV)
+	    o->op_private |= OPpMAYBE_LVSUB;
+	PL_modcount++;
+	break;
     case OP_RV2SV:
 	ref(cUNOPo->op_first, o->op_type);
 	localize = 1;
 	/* FALL THROUGH */
     case OP_GV:
-    case OP_AV2ARYLEN:
 	PL_hints |= HINT_BLOCK_SCOPE;
     case OP_SASSIGN:
     case OP_ANDASSIGN:
diff --git a/t/op/tiearray.t b/t/op/tiearray.t
index 5ef6bfb..ca8a3c3 100644
--- a/t/op/tiearray.t
+++ b/t/op/tiearray.t
@@ -147,7 +147,7 @@ sub FETCHSIZE { -1 }
 
 package main;
   
-print "1..62\n";                   
+print "1..66\n";                   
 my $test = 1;
 
 {my @ary;
@@ -234,7 +234,6 @@ print "ok ", $test++,"\n";
 print "not " unless join(':',@ary) eq '1:2:3';
 print "ok ", $test++,"\n";         
 
-  
 my $t = 0;
 foreach $n (@ary)
  {
@@ -265,6 +264,19 @@ print "ok ", $test++,"\n";
 print "not " unless join(':',@ary) eq '3:2:1';
 print "ok ", $test++,"\n";         
 
+$#ary = 1;
+print "not " unless $seen{'STORESIZE'} == 1;
+print "ok ", $test++," -- seen STORESIZE\n";
+print "not " unless join(':',@ary) eq '3:2';
+print "ok ", $test++,"\n";
+
+sub arysize :lvalue { $#ary }
+arysize()--;
+print "not " unless $seen{'STORESIZE'} == 2;
+print "ok ", $test++," -- seen STORESIZE\n";
+print "not " unless join(':',@ary) eq '3';
+print "ok ", $test++,"\n";
+
 untie @ary;   
 
 }