This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Allow lvalue subs to return COWs in list context
authorFather Chrysostomos <sprout@cpan.org>
Tue, 31 May 2011 06:01:39 +0000 (23:01 -0700)
committerFather Chrysostomos <sprout@cpan.org>
Tue, 31 May 2011 06:01:39 +0000 (23:01 -0700)
Commit f71f472 missed list assignment. :-(

pp_hot.c
t/op/sub_lval.t

index 9730af7..75811a2 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -2745,7 +2745,11 @@ PP(pp_leavesublv)
            EXTEND_MORTAL(SP - newsp);
            for (mark = newsp + 1; mark <= SP; mark++) {
                if (*mark != &PL_sv_undef
-                   && SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP | SVf_READONLY)) {
+                   && (SvFLAGS(*mark) & (SVs_TEMP | SVs_PADTMP)
+                      || (SvFLAGS(*mark) & (SVf_READONLY|SVf_FAKE))
+                            == SVf_READONLY
+                      )
+               ) {
                    /* Might be flattened array after $#array =  */
                    PUTBACK;
                    LEAVE;
index 6aa516b..e51936f 100644 (file)
@@ -3,7 +3,7 @@ BEGIN {
     @INC = '../lib';
     require './test.pl';
 }
-plan tests=>97;
+plan tests=>99;
 
 sub a : lvalue { my $a = 34; ${\(bless \$a)} }  # Return a temporary
 sub b : lvalue { ${\shift} }
@@ -656,3 +656,6 @@ sub fleen : lvalue { $pnare }
 $pnare = __PACKAGE__;
 ok eval { fleen = 1 }, "lvalues can return COWs (CATTLE?) [perl #75656]";\
 is $pnare, 1, 'and returning CATTLE actually works';
+$pnare = __PACKAGE__;
+ok eval { (fleen) = 1 }, "lvalues can return COWs in list context";
+is $pnare, 1, 'and returning COWs in list context actually works';