diff options
| -rw-r--r-- | av.c | 5 | ||||
| -rwxr-xr-x | t/op/args.t | 21 |
2 files changed, 24 insertions, 2 deletions
@@ -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 4ea224d885..02d63521e0 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'); +} + + |