Re: local tied hash slices & stray keys (was Re: Cwd breakage)

Message-ID: <Pine.LNX.4.33.0206030822330.2695-100000@mako.covalent.net>

(plus a test expanded from Schwern's [ID 20020602.006])

p4raw-id: //depot/perl@17022

diff --git a/pp.c b/pp.c
index 531516b..08cb9cf 100644 (file)
--- a/pp.c
+++ b/pp.c
@@ -3825,17 +3825,38 @@ PP(pp_hslice)
     register HV *hv = (HV*)POPs;
     register I32 lval = (PL_op->op_flags & OPf_MOD || LVRET);
     I32 realhv = (SvTYPE(hv) == SVt_PVHV);
+    bool localizing = PL_op->op_private & OPpLVAL_INTRO ? TRUE : FALSE;
+    bool other_magic = FALSE;
 
-    if (!realhv && PL_op->op_private & OPpLVAL_INTRO)
+    if (localizing) {
+        MAGIC *mg;
+        HV *stash;
+
+        other_magic = mg_find((SV*)hv, PERL_MAGIC_env) ||
+            ((mg = mg_find((SV*)hv, PERL_MAGIC_tied))
+             /* Try to preserve the existenceness of a tied hash
+              * element by using EXISTS and DELETE if possible.
+              * Fallback to FETCH and STORE otherwise */
+             && (stash = SvSTASH(SvRV(SvTIED_obj((SV*)hv, mg))))
+             && gv_fetchmethod_autoload(stash, "EXISTS", TRUE)
+             && gv_fetchmethod_autoload(stash, "DELETE", TRUE));
+    }
+
+    if (!realhv && localizing)
        DIE(aTHX_ "Can't localize pseudo-hash element");
 
     if (realhv || SvTYPE(hv) == SVt_PVAV) {
        while (++MARK <= SP) {
            SV *keysv = *MARK;
            SV **svp;
-           I32 preeminent = SvRMAGICAL(hv) ? 1 :
-                               realhv ? hv_exists_ent(hv, keysv, 0)
-                                      : avhv_exists_ent((AV*)hv, keysv, 0);
+           I32 preeminent;
+
+            if (localizing) {
+                preeminent = SvRMAGICAL(hv) && !other_magic ? 1 :
+                    realhv ? hv_exists_ent(hv, keysv, 0)
+                    : avhv_exists_ent((AV*)hv, keysv, 0);
+            }
+
            if (realhv) {
                HE *he = hv_fetch_ent(hv, keysv, lval, 0);
                svp = he ? &HeVAL(he) : 0;
@@ -3848,7 +3869,7 @@ PP(pp_hslice)
                    STRLEN n_a;
                    DIE(aTHX_ PL_no_helem, SvPV(keysv, n_a));
                }
-               if (PL_op->op_private & OPpLVAL_INTRO) {
+               if (localizing) {
                    if (preeminent)
                        save_helem(hv, keysv, svp);
                    else {

diff --git a/t/op/tie.t b/t/op/tie.t
index 5a72a1b..d3bd452 100755 (executable)
--- a/t/op/tie.t
+++ b/t/op/tie.t
@@ -240,3 +240,30 @@ tie FH, 'main';
 EXPECT
 Can't modify constant item in tie at - line 3, near "'main';"
 Execution of - aborted due to compilation errors.
+########
+
+# localizing tied hash slices
+$ENV{FooA} = 1;
+$ENV{FooB} = 2;
+print exists $ENV{FooA} ? 1 : 0, "\n";
+print exists $ENV{FooB} ? 2 : 0, "\n";
+print exists $ENV{FooC} ? 3 : 0, "\n";
+{
+    local @ENV{qw(FooA FooC)};
+    print exists $ENV{FooA} ? 4 : 0, "\n";
+    print exists $ENV{FooB} ? 5 : 0, "\n";
+    print exists $ENV{FooC} ? 6 : 0, "\n";
+}
+print exists $ENV{FooA} ? 7 : 0, "\n";
+print exists $ENV{FooB} ? 8 : 0, "\n";
+print exists $ENV{FooC} ? 9 : 0, "\n"; # this should not exist
+EXPECT
+1
+2
+0
+4
+5
+6
+7
+8
+0