This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
[perl #126633] copy anything gmagical on the right
authorTony Cook <tony@develop-help.com>
Tue, 8 Dec 2015 00:19:48 +0000 (11:19 +1100)
committerTony Cook <tony@develop-help.com>
Sun, 10 Jan 2016 21:51:16 +0000 (08:51 +1100)
It could retrieve something we're setting on the left.

pp_hot.c
t/op/aassign.t

index 650f06b..b80efae 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -1173,7 +1173,7 @@ S_aassign_copy_common(pTHX_ SV **firstlelem, SV **lastlelem,
         svr = *relem;
         assert(svr);
 
-        if (UNLIKELY(SvFLAGS(svr) & SVf_BREAK || copy_all)) {
+        if (UNLIKELY(SvFLAGS(svr) & (SVf_BREAK|SVs_GMG) || copy_all)) {
 
 #ifdef DEBUGGING
             if (fake) {
@@ -1265,6 +1265,10 @@ PP(pp_aassign)
 
     /* at least 2 LH and RH elements, or commonality isn't an issue */
     if (firstlelem < lastlelem && firstrelem < lastrelem) {
+        for (relem = firstrelem+1; relem <= lastrelem; relem++) {
+            if (SvGMAGICAL(*relem))
+                goto do_scan;
+        }
         for (lelem = firstlelem; lelem <= lastlelem; lelem++) {
             if (*lelem && SvSMAGICAL(*lelem))
                 goto do_scan;
index d6a1a42..03cc84c 100644 (file)
@@ -345,9 +345,10 @@ SKIP: {
 
 { # magic handling, see #126633
     use v5.22;
+    my $set;
     package ArrayProxy {
         sub TIEARRAY { bless [ $_[1] ] }
-        sub STORE { $_[0][0]->[$_[1]] = $_[2] }
+        sub STORE { $_[0][0]->[$_[1]] = $_[2]; $set = 1 }
         sub FETCH { $_[0][0]->[$_[1]] }
         sub CLEAR { @{$_[0][0]} = () }
         sub EXTEND {}
@@ -363,9 +364,7 @@ SKIP: {
     @real = @base;
     @real[0, 1] = @proxy[1, 0];
     is($real[0], "b", "tied right first");
-    { local $::TODO = "#126633";
     is($real[1], "a", "tied right second");
-    }
     @real = @base;
     @proxy[0, 1] = @proxy[1, 0];
     is($real[0], "b", "tied both first");
@@ -379,6 +378,10 @@ SKIP: {
     @real = @base;
     ($temp, @proxy) = @proxy[1, 0];
     is($real[0], "a", "scalar/array tied both");
+    $set = 0;
+    my $orig;
+    ($proxy[0], $orig) = (1, $set);
+    is($orig, 0, 'previous value of $set');
 }
 
 done_testing();