diff options
-rw-r--r-- | pp.c | 12 | ||||
-rw-r--r-- | pp_hot.c | 13 | ||||
-rw-r--r-- | scope.c | 1 | ||||
-rwxr-xr-x | t/op/local.t | 13 |
4 files changed, 33 insertions, 6 deletions
@@ -2833,6 +2833,7 @@ PP(pp_hslice) while (++MARK <= SP) { SV *keysv = *MARK; SV **svp; + I32 preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0); if (realhv) { HE *he = hv_fetch_ent(hv, keysv, lval, 0); svp = he ? &HeVAL(he) : 0; @@ -2845,8 +2846,15 @@ PP(pp_hslice) STRLEN n_a; DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a)); } - if (PL_op->op_private & OPpLVAL_INTRO) - save_helem(hv, keysv, svp); + if (PL_op->op_private & OPpLVAL_INTRO) { + if (preeminent) + save_helem(hv, keysv, svp); + else { + STRLEN keylen; + char *key = SvPV(keysv, keylen); + save_delete(hv, key, keylen); + } + } } *MARK = svp ? *svp : &PL_sv_undef; } @@ -1532,8 +1532,11 @@ PP(pp_helem) U32 defer = PL_op->op_private & OPpLVAL_DEFER; SV *sv; U32 hash = (SvFAKE(keysv) && SvREADONLY(keysv)) ? SvUVX(keysv) : 0; + I32 preeminent; if (SvTYPE(hv) == SVt_PVHV) { + if (PL_op->op_private & OPpLVAL_INTRO) + preeminent = SvRMAGICAL(hv) ? 1 : hv_exists_ent(hv, keysv, 0); he = hv_fetch_ent(hv, keysv, lval && !defer, hash); svp = he ? &HeVAL(he) : 0; } @@ -1566,8 +1569,14 @@ PP(pp_helem) if (PL_op->op_private & OPpLVAL_INTRO) { if (HvNAME(hv) && isGV(*svp)) save_gp((GV*)*svp, !(PL_op->op_flags & OPf_SPECIAL)); - else - save_helem(hv, keysv, svp); + else { + if (!preeminent) { + STRLEN keylen; + char *key = SvPV(keysv, keylen); + save_delete(hv, key, keylen); + } else + save_helem(hv, keysv, svp); + } } else if (PL_op->op_private & OPpDEREF) vivify_ref(*svp, PL_op->op_private & OPpDEREF); @@ -852,7 +852,6 @@ Perl_leave_scope(pTHX_ I32 base) ptr = SSPOPPTR; (void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD); SvREFCNT_dec(hv); - Safefree(ptr); break; case SAVEt_DESTRUCTOR: ptr = SSPOPPTR; diff --git a/t/op/local.t b/t/op/local.t index b478e01993..781afa5b35 100755 --- a/t/op/local.t +++ b/t/op/local.t @@ -1,6 +1,6 @@ #!./perl -print "1..69\n"; +print "1..71\n"; # XXX known to leak scalars $ENV{PERL_DESTRUCT_LEVEL} = 0 unless $ENV{PERL_DESTRUCT_LEVEL} > 3; @@ -235,3 +235,14 @@ while (/(o.+?),/gc) { untie $_; } +{ + # BUG 20001205.22 + my %x; + $x{a} = 1; + { local $x{b} = 1; } + print "not " if exists $x{b}; + print "ok 70\n"; + { local @x{c,d,e}; } + print "not " if exists $x{c}; + print "ok 71\n"; +} |