diff options
| -rw-r--r-- | pp.c | 8 | ||||
| -rw-r--r-- | pp.h | 4 | ||||
| -rw-r--r-- | pp_hot.c | 2 | ||||
| -rw-r--r-- | t/op/local.t | 34 |
4 files changed, 39 insertions, 9 deletions
@@ -4402,8 +4402,7 @@ S_do_delete_local(pTHX) SV * const osv = POPs; const bool tied = SvRMAGICAL(osv) && mg_find((const SV *)osv, PERL_MAGIC_tied); - const bool can_preserve = SvCANEXISTDELETE(osv) - || mg_find((const SV *)osv, PERL_MAGIC_env); + const bool can_preserve = SvCANEXISTDELETE(osv); const U32 type = SvTYPE(osv); if (type == SVt_PVHV) { /* hash element */ HV * const hv = MUTABLE_HV(osv); @@ -4491,8 +4490,7 @@ S_do_delete_local(pTHX) SV * const osv = POPs; const bool tied = SvRMAGICAL(osv) && mg_find((const SV *)osv, PERL_MAGIC_tied); - const bool can_preserve = SvCANEXISTDELETE(osv) - || mg_find((const SV *)osv, PERL_MAGIC_env); + const bool can_preserve = SvCANEXISTDELETE(osv); const U32 type = SvTYPE(osv); SV *sv = NULL; if (type == SVt_PVHV) { @@ -4678,7 +4676,7 @@ PP(pp_hslice) MAGIC *mg; HV *stash; - if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env)) + if (SvCANEXISTDELETE(hv)) can_preserve = TRUE; } @@ -475,8 +475,8 @@ True if this op will be the return value of an lvalue subroutine #define SvCANEXISTDELETE(sv) \ (!SvRMAGICAL(sv) \ - || ((mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ - && (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ + || !(mg = mg_find((const SV *) sv, PERL_MAGIC_tied)) \ + || ( (stash = SvSTASH(SvRV(SvTIED_obj(MUTABLE_SV(sv), mg)))) \ && gv_fetchmethod_autoload(stash, "EXISTS", TRUE) \ && gv_fetchmethod_autoload(stash, "DELETE", TRUE) \ ) \ @@ -1792,7 +1792,7 @@ PP(pp_helem) * Try to preserve the existenceness of a tied hash * element by using EXISTS and DELETE if possible. * Fallback to FETCH and STORE otherwise. */ - if (SvCANEXISTDELETE(hv) || mg_find((const SV *)hv, PERL_MAGIC_env)) + if (SvCANEXISTDELETE(hv)) preeminent = hv_exists_ent(hv, keysv, 0); } diff --git a/t/op/local.t b/t/op/local.t index d70feb7b07..3b9b0212ed 100644 --- a/t/op/local.t +++ b/t/op/local.t @@ -5,7 +5,7 @@ BEGIN { @INC = qw(. ../lib); require './test.pl'; } -plan tests => 305; +plan tests => 310; my $list_assignment_supported = 1; @@ -781,6 +781,27 @@ like( runperl(stderr => 1, 'index(q(a), foo);' . 'local *g=${::}{foo};print q(ok);'), "ok", "[perl #52740]"); +# related to perl #112966 +# Magic should not cause elements not to be deleted after scope unwinding +# when they did not exist before local() +() = \$#squinch; # $#foo in lvalue context makes array magical +{ + local $squinch[0]; + local @squinch[1..2]; + package Flibbert; + m??; # makes stash magical + local $Flibbert::{foo}; + local @Flibbert::{<bar baz>}; +} +ok !exists $Flibbert::{foo}, + 'local helem on magic hash does not leave elems on scope exit'; +ok !exists $Flibbert::{bar}, + 'local hslice on magic hash does not leave elems on scope exit'; +ok !exists $squinch[0], + 'local aelem on magic hash does not leave elems on scope exit'; +ok !exists $squinch[1], + 'local aslice on magic hash does not leave elems on scope exit'; + # Keep these tests last, as they can SEGV { local *@; @@ -793,3 +814,14 @@ like( runperl(stderr => 1, delete $::{$_} for 'nugguton','netgonch'; } pass ('localised arrays and hashes do not crash if glob is deleted'); + +# [perl #112966] Rmagic can cause delete local to crash +package Grompits { +local $SIG{__WARN__}; + delete local $ISA[0]; + delete local @ISA[1..10]; + m??; # makes stash magical + delete local $Grompits::{foo}; + delete local @Grompits::{<foo bar>}; +} +pass 'rmagic does not cause delete local to crash on nonexistent elems'; |