Stop array assignment from leaking on croak

This made a to-do test in sort.t pass, but adventitiously, so I modi-
fied it to fail again.

3 files changed, 11 insertions, 6 deletions

diff --git a/pp_hot.c b/pp_hot.c
index 6057614f45..a8d762be5a 100644
--- a/pp_hot.c
+++ b/pp_hot.c
@@ -982,15 +982,14 @@ PP(pp_aassign)
 	    while (relem <= lastrelem) {	/* gobble up all the rest */
 		SV **didstore;
 		assert(*relem);
-		sv = newSV(0);
+		sv = sv_newmortal();
 		sv_setsv(sv, *relem);
 		*(relem++) = sv;
 		didstore = av_store(ary,i++,sv);
+		if (didstore) SvREFCNT_inc_simple_void_NN(sv);
 		if (magic) {
 		    if (SvSMAGICAL(sv))
 			mg_set(sv);
-		    if (!didstore)
-			sv_2mortal(sv);
 		}
 		TAINT_NOT;
 	    }
diff --git a/t/op/sort.t b/t/op/sort.t
index 6dedeeba55..0371f4f7a8 100644
--- a/t/op/sort.t
+++ b/t/op/sort.t
@@ -770,7 +770,8 @@ cmp_ok($answer,'eq','good','sort subr called from other package');
 
 {
     local $TODO = "sort should make sure elements are not freed in the sort block";
-    eval { @nomodify_x=(1..8); our @copy = sort { @nomodify_x = (0) } (@nomodify_x, 3); };
+    eval { @nomodify_x=(1..8);
+	   our @copy = sort { undef @nomodify_x; 1 } (@nomodify_x, 3); };
     is($@, "");
 }
 
diff --git a/t/op/svleak.t b/t/op/svleak.t
index 6ed0408006..d975cf120c 100644
--- a/t/op/svleak.t
+++ b/t/op/svleak.t
@@ -15,7 +15,7 @@ BEGIN {
 
 use Config;
 
-plan tests => 30;
+plan tests => 31;
 
 # run some code N times. If the number of SVs at the end of loop N is
 # greater than (N-1)*delta at the end of loop 1, we've got a leak
@@ -200,7 +200,8 @@ leak(2, 0, sub {
     undef $h;
 }, 'tied hash iteration does not leak');
 
-# Hash assignment was leaking when assigning explosive scalars
+# List assignment was leaking when assigning explosive scalars to
+# aggregates.
 package sty {
     sub TIESCALAR { bless [] }
     sub FETCH    { die }
@@ -211,4 +212,8 @@ leak(2, 0, sub {
     eval {%a = (0, $x)}; # value
     eval {%a = ($x,$x)}; # both
 }, 'hash assignment does not leak');
+leak(2, 0, sub {
+    tie my $x, sty;
+    eval {@a = ($x)};
+}, 'array assignment does not leak');