fix for #23790.
authorMarty Pauley <marty@martian.org>
Sun, 24 Oct 2010 09:02:40 +0000 (18:02 +0900)
committerFather Chrysostomos <sprout@cpan.org>
Thu, 4 Nov 2010 07:33:47 +0000 (00:33 -0700)
padav is leaving an arrayref on the stack when producing the return value for an
lvalue sub.  But when this is in an argument list it really should be a array,
not a ref.  So, in leavesublv I check for this case and expand the arrayref to
an array.

pp_hot.c
t/op/sub_lval.t

index 9beb604..8c9c915 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2595,6 +2595,29 @@ PP(pp_leavesublv)
        if (gimme == G_SCALAR)
            goto temporise;
        if (gimme == G_ARRAY) {
+           mark = newsp + 1;
+           /* We want an array here, but padav will have left us an arrayref for an lvalue,
+            * so we need to expand it */
+           if(SvTYPE(*mark) == SVt_PVAV) {
+               AV *const av = MUTABLE_AV(*mark);
+               const I32 maxarg = AvFILL(av) + 1;
+               (void)POPs; /* get rid of the array ref */
+               EXTEND(SP, maxarg);
+               if (SvRMAGICAL(av)) {
+                   U32 i;
+                   for (i=0; i < (U32)maxarg; i++) {
+                       SV ** const svp = av_fetch(av, i, FALSE);
+                       SP[i+1] = svp
+                           ? SvGMAGICAL(*svp) ? (mg_get(*svp), *svp) : *svp
+                           : &PL_sv_undef;
+                   }
+               }
+               else {
+                   Copy(AvARRAY(av), SP+1, maxarg, SV*);
+               }
+               SP += maxarg;
+               PUTBACK;
+           }
            if (!CvLVALUE(cx->blk_sub.cv))
                goto temporise_array;
            EXTEND_MORTAL(SP - newsp);
index aedaba0..d0ba84a 100644 (file)
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>74;
+plan tests=>76;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -527,8 +527,7 @@ TODO: {
     is($blah, 8, "yada");
 }
 
-TODO: {
-    local $TODO = "bug #23790";
+{ # bug #23790
     my @arr  = qw /one two three/;
     my $line = "zero";
     sub lval_array () : lvalue {@arr}
@@ -538,6 +537,13 @@ TODO: {
     }
 
     is($line, "zeroonetwothree");
+
+    sub trythislval { scalar(@_)."x".join "", @_ }
+    is(trythislval(lval_array()), "3xonetwothree");
+
+    sub changeme { $_[2] = "free" }
+    changeme(lval_array);
+    is("@arr", "one two free");
 }
 
 {