Allow COW copies in aassign

When the ‘no common vars’ optimisation is not active, list assignment
does not allow COW copies (unless assigning to an empty hash or
array).  It has been this way since 61e5f455dc.  The recent addition
of sv_mortalcopy_flags gives us an easy way to fix this.

A certain test in tr.t was marked TODO if not given a COW.  This test
used to pass before 61e5f455dc, but after than becaming a failing TODO
test.  It makes sense to test that we do have a COW instead of having
a conditional TODO.

diff --git a/pp_hot.c b/pp_hot.c
index 7994992..9d28855 100644 (file)
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -955,9 +955,11 @@ PP(pp_aassign)
                    Perl_croak(aTHX_ "panic: attempt to copy freed scalar %p",
                               (void*)sv);
                }
-               /* Specifically *not* sv_mortalcopy(), as that will steal TEMPs,
-                  and we need a second copy of a temp here.  */
-               *relem = sv_2mortal(newSVsv(sv));
+               /* Not newSVsv(), as it does not allow copy-on-write,
+                  resulting in wasteful copies.  We need a second copy of
+                  a temp here, hence the SV_NOSTEAL.  */
+               *relem = sv_mortalcopy_flags(sv,SV_GMAGIC|SV_DO_COW_SVSETSV
+                                              |SV_NOSTEAL);
            }
        }
     }

diff --git a/t/op/tr.t b/t/op/tr.t
index 61f570c..41746fc 100644 (file)
--- a/t/op/tr.t
+++ b/t/op/tr.t
@@ -8,7 +8,7 @@ BEGIN {
     require './test.pl';
 }
 
-plan tests => 131;
+plan tests => 132;
 
 my $Is_EBCDIC = (ord('i') == 0x89 & ord('J') == 0xd1);
 
@@ -486,9 +486,9 @@ is($s, "AxBC", "utf8, DELETE");
 
 ($s) = keys %{{pie => 3}};
 SKIP: {
-    if (!eval { require B }) { skip "no B", 1 }
+    if (!eval { require B }) { skip "no B", 2 }
     my $wasro = B::svref_2object(\$s)->FLAGS & &B::SVf_READONLY;
-    $wasro or local $TODO = "didn't have a COW";
+    ok $wasro, "have a COW";
     $s =~ tr/i//;
     ok( B::svref_2object(\$s)->FLAGS & &B::SVf_READONLY,
        "count-only tr doesn't deCOW COWs" );