In perl.git, the branch blead has been updated
<http://perl5.git.perl.org/perl.git/commitdiff/28c5b5bcd7f52e6b2219508a1066cd0ccc8dd19a?hp=34861f291d6c548304b74dfc30ff27447f1b582f>
- Log -----------------------------------------------------------------
commit 28c5b5bcd7f52e6b2219508a1066cd0ccc8dd19a
Author: Rafael Garcia-Suarez <r...@consttype.org>
Date: Wed Oct 28 10:44:31 2009 +0100
$#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.
M op.c
M t/op/tiearray.t
commit 02d85cc37a4acecafdc2f0b45640b03cd1f4ac71
Author: Eric Brine <ikeg...@adaelis.com>
Date: Fri Oct 23 19:05:40 2009 -0400
Avoid adding magic with rvalue $#a
M pp.c
-----------------------------------------------------------------------
Summary of changes:
op.c | 7 ++++++-
pp.c | 17 ++++++++++++-----
t/op/tiearray.t | 16 ++++++++++++++--
3 files changed, 32 insertions(+), 8 deletions(-)
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/pp.c b/pp.c
index a2704af..80bb590 100644
--- a/pp.c
+++ b/pp.c
@@ -321,12 +321,19 @@ PP(pp_av2arylen)
{
dVAR; dSP;
AV * const av = MUTABLE_AV(TOPs);
- SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
- if (!*sv) {
- *sv = newSV_type(SVt_PVMG);
- sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+ const I32 lvalue = PL_op->op_flags & OPf_MOD || LVRET;
+ if (lvalue) {
+ SV ** const sv = Perl_av_arylen_p(aTHX_ MUTABLE_AV(av));
+ if (!*sv) {
+ *sv = newSV_type(SVt_PVMG);
+ sv_magic(*sv, MUTABLE_SV(av), PERL_MAGIC_arylen, NULL, 0);
+ }
+ SETs(*sv);
+ } else {
+ SETs(sv_2mortal(newSViv(
+ AvFILL(MUTABLE_AV(av)) + CopARYBASE_get(PL_curcop)
+ )));
}
- SETs(*sv);
RETURN;
}
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;
}
--
Perl5 Master Repository
