From: Father Chrysostomos <sprout@cpan.org>
Date: Sat, 22 Sep 2012 19:06:45 +0000 (-0700)
Subject: Stop array assignment from leaking on croak
X-Git-Tag: upstream/5.20.0~5332
X-Git-Url: http://review.tizen.org/git/?a=commitdiff_plain;h=39984de3a8e9c16c0fee320a579cb465d0ce7314;p=platform%2Fupstream%2Fperl.git

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.
---

diff --git a/pp_hot.c b/pp_hot.c
index 6057614..a8d762b 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 6dedeeb..0371f4f 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 6ed0408..d975cf1 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');