From: Dave Mitchell <davem@fdisolutions.com>
Date: Wed, 31 Mar 2004 20:33:52 +0000 (+0000)
Subject:  [perl #28032] delete $_[0] + (\$) prototype = bad free
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=a62140726edcf5b33bdd8fed9a26ab90d77ec144;p=p5sagit%2Fp5-mst-13.2.git

 [perl #28032] delete $_[0] + (\$) prototype = bad free
 av_delete() didn't reify. I also updated its description

p4raw-id: //depot/perl@22624
---

diff --git a/av.c b/av.c
index ac623cc..9cae023 100644
--- a/av.c
+++ b/av.c
@@ -782,7 +782,8 @@ Perl_av_fill(pTHX_ register AV *av, I32 fill)
 =for apidoc av_delete
 
 Deletes the element indexed by C<key> from the array.  Returns the
-deleted element. C<flags> is currently ignored.
+deleted element. If C<flags> equals C<G_DISCARD>, the element is freed
+and null is returned.
 
 =cut
 */
@@ -840,6 +841,8 @@ Perl_av_delete(pTHX_ AV *av, I32 key, I32 flags)
     if (key > AvFILLp(av))
 	return Nullsv;
     else {
+	if (!AvREAL(av) && AvREIFY(av))
+	    av_reify(av);
 	sv = AvARRAY(av)[key];
 	if (key == AvFILLp(av)) {
 	    AvARRAY(av)[key] = &PL_sv_undef;
diff --git a/t/op/args.t b/t/op/args.t
index 4ea224d..02d6352 100755
--- a/t/op/args.t
+++ b/t/op/args.t
@@ -6,7 +6,7 @@ BEGIN {
 }
 
 require './test.pl';
-plan( tests => 20 );
+plan( tests => 23 );
 
 # test various operations on @_
 
@@ -86,3 +86,22 @@ for (1..3) {
     is(join('',bar('d')),'Dd');
     is(join('',baz('e')),'eE');
 } 
+
+# [perl #28032] delete $_[0] was freeing things too early
+
+{
+    my $flag = 0;
+    sub X::DESTROY { $flag = 1 }
+    sub f {
+	delete $_[0];
+	ok(!$flag, 'delete $_[0] : in f');
+    }
+    {
+	my $x = bless [], 'X';
+	f($x);
+	ok(!$flag, 'delete $_[0] : after f');
+    }
+    ok($flag, 'delete $_[0] : outside block');
+}
+
+