This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
$#array should be accepted as a lvalue sub return value.
authorRafael Garcia-Suarez <rgs@consttype.org>
Wed, 28 Oct 2009 09:44:31 +0000 (10:44 +0100)
committerRafael Garcia-Suarez <rgs@consttype.org>
Wed, 28 Oct 2009 09:44:31 +0000 (10:44 +0100)
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.

op.c
t/op/tiearray.t

diff --git a/op.c b/op.c
index 8741337..d7a5234 100644 (file)
--- 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:
index 5ef6bfb..ca8a3c3 100644 (file)
@@ -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;   
 
 }