[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 (file)
--- 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 (executable)
--- 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');
+}
+
+