Revert "process xhv_backreferences early in S_hfreeentries"
authorDavid Mitchell <davem@iabyn.com>
Thu, 29 Jul 2010 12:33:19 +0000 (13:33 +0100)
committerDavid Mitchell <davem@iabyn.com>
Thu, 29 Jul 2010 12:33:19 +0000 (13:33 +0100)
This reverts commit 044d8c24fa9214cf0fe9c6fc8a44e03f3f5374d7.

Conflicts:

hv.c

That commit tried to simply the xhv_backreferences processing, but
was totally wrong and broke ordinary weak refs to hashes (see #76716).

embed.fnc
embed.h
hv.c
proto.h
sv.c

index 289538f..8384d80 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -2138,6 +2138,10 @@ Apo      |void   |hv_eiter_set   |NN HV *hv|NULLOK HE *eiter
 Ap     |void   |hv_name_set    |NN HV *hv|NULLOK const char *name|U32 len|U32 flags
 : Used in dump.c and hv.c
 poM    |AV**   |hv_backreferences_p    |NN HV *hv
+#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+: Only used in sv.c
+poM    |void   |hv_kill_backrefs       |NN HV *hv
+#endif
 Apd    |void   |hv_clear_placeholders  |NN HV *hv
 ApoR   |I32*   |hv_placeholders_p      |NN HV *hv
 ApoR   |I32    |hv_placeholders_get    |NN const HV *hv
diff --git a/embed.h b/embed.h
index 6f5e151..4eb1631 100644 (file)
--- a/embed.h
+++ b/embed.h
 #endif
 #define hv_scalar              Perl_hv_scalar
 #define hv_name_set            Perl_hv_name_set
+#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+#endif
 #define hv_clear_placeholders  Perl_hv_clear_placeholders
 #ifdef PERL_CORE
 #define magic_scalarpack       Perl_magic_scalarpack
 #define hv_name_set(a,b,c,d)   Perl_hv_name_set(aTHX_ a,b,c,d)
 #ifdef PERL_CORE
 #endif
+#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+#ifdef PERL_CORE
+#endif
+#endif
 #define hv_clear_placeholders(a)       Perl_hv_clear_placeholders(aTHX_ a)
 #ifdef PERL_CORE
 #define magic_scalarpack(a,b)  Perl_magic_scalarpack(aTHX_ a,b)
diff --git a/hv.c b/hv.c
index 1ec7ffc..bb80329 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1665,13 +1665,28 @@ S_hfreeentries(pTHX_ HV *hv)
        if (SvOOK(hv)) {
            HE *entry;
             struct mro_meta *meta;
-           struct xpvhv_aux * const iter = HvAUX(hv);
-           AV *const av = iter->xhv_backreferences;
+           struct xpvhv_aux *iter = HvAUX(hv);
+           /* If there are weak references to this HV, we need to avoid
+              freeing them up here.  In particular we need to keep the AV
+              visible as what we're deleting might well have weak references
+              back to this HV, so the for loop below may well trigger
+              the removal of backreferences from this array.  */
+
+           if (iter->xhv_backreferences) {
+               /* So donate them to regular backref magic to keep them safe.
+                  The sv_magic will increase the reference count of the AV,
+                  so we need to drop it first. */
+               SvREFCNT_dec(iter->xhv_backreferences);
+               if (AvFILLp(iter->xhv_backreferences) == -1) {
+                   /* Turns out that the array is empty. Just free it.  */
+                   SvREFCNT_dec(iter->xhv_backreferences);
 
-           if (av) {
-               Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
-               SvREFCNT_dec(av);
-               iter->xhv_backreferences = 0;
+               } else {
+                   sv_magic(MUTABLE_SV(hv),
+                            MUTABLE_SV(iter->xhv_backreferences),
+                            PERL_MAGIC_backref, NULL, 0);
+               }
+               iter->xhv_backreferences = NULL;
            }
 
            entry = iter->xhv_eiter; /* HvEITER(hv) */
@@ -1707,7 +1722,7 @@ S_hfreeentries(pTHX_ HV *hv)
        }
 
        /* make everyone else think the array is empty, so that the destructors
-        * called for freed entries can't recursively mess with us */
+        * called for freed entries can't recusively mess with us */
        HvARRAY(hv) = NULL;
        ((XPVHV*) SvANY(hv))->xhv_keys = 0;
 
@@ -2010,6 +2025,24 @@ Perl_hv_backreferences_p(pTHX_ HV *hv) {
     return &(iter->xhv_backreferences);
 }
 
+void
+Perl_hv_kill_backrefs(pTHX_ HV *hv) {
+    AV *av;
+
+    PERL_ARGS_ASSERT_HV_KILL_BACKREFS;
+
+    if (!SvOOK(hv))
+       return;
+
+    av = HvAUX(hv)->xhv_backreferences;
+
+    if (av) {
+       HvAUX(hv)->xhv_backreferences = 0;
+       Perl_sv_kill_backrefs(aTHX_ MUTABLE_SV(hv), av);
+       SvREFCNT_dec(av);
+    }
+}
+
 /*
 hv_iternext is implemented as a macro in hv.h
 
diff --git a/proto.h b/proto.h
index 6c5fc52..1275e17 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -6479,6 +6479,13 @@ PERL_CALLCONV AV**       Perl_hv_backreferences_p(pTHX_ HV *hv)
 #define PERL_ARGS_ASSERT_HV_BACKREFERENCES_P   \
        assert(hv)
 
+#if defined(PERL_IN_DUMP_C) || defined(PERL_IN_HV_C) || defined(PERL_IN_SV_C)
+PERL_CALLCONV void     Perl_hv_kill_backrefs(pTHX_ HV *hv)
+                       __attribute__nonnull__(pTHX_1);
+#define PERL_ARGS_ASSERT_HV_KILL_BACKREFS      \
+       assert(hv)
+
+#endif
 PERL_CALLCONV void     Perl_hv_clear_placeholders(pTHX_ HV *hv)
                        __attribute__nonnull__(pTHX_1);
 #define PERL_ARGS_ASSERT_HV_CLEAR_PLACEHOLDERS \
diff --git a/sv.c b/sv.c
index c762357..4e348a6 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -5310,17 +5310,19 @@ Perl_sv_rvweaken(pTHX_ SV *const sv)
 /* A discussion about the backreferences array and its refcount:
  *
  * The AV holding the backreferences is pointed to either as the mg_obj of
- * PERL_MAGIC_backref, or in the specific case of a HV, from the
- * xhv_backreferences field of the HvAUX structure. The array is created
- * with a refcount of 2. This means that if during global destruction the
- * array gets picked on before its parent to have its refcount decremented
- * by the random zapper, it won't actually be freed, meaning it's still
- * there for when its parent gets freed.
+ * PERL_MAGIC_backref, or in the specific case of a HV that has the hv_aux
+ * structure, from the xhv_backreferences field. (A HV without hv_aux will
+ * have the standard magic instead.) The array is created with a refcount
+ * of 2. This means that if during global destruction the array gets
+ * picked on first to have its refcount decremented by the random zapper,
+ * it won't actually be freed, meaning it's still theere for when its
+ * parent gets freed.
  * When the parent SV is freed, in the case of magic, the magic is freed,
  * Perl_magic_killbackrefs is called which decrements one refcount, then
  * mg_obj is freed which kills the second count.
- * In the vase of a HV being freed, one ref is removed by S_hfreeentries,
- * the other by Perl_sv_kill_backrefs, which it calls.
+ * In the vase of a HV being freed, one ref is removed by
+ * Perl_hv_kill_backrefs, the other by Perl_sv_kill_backrefs, which it
+ * calls.
  */
 
 void
@@ -5336,9 +5338,23 @@ Perl_sv_add_backref(pTHX_ SV *const tsv, SV *const sv)
 
        av = *avp;
        if (!av) {
-           av = newAV();
-           AvREAL_off(av);
-           SvREFCNT_inc_simple_void(av); /* see discussion above */
+           /* There is no AV in the offical place - try a fixup.  */
+           MAGIC *const mg = mg_find(tsv, PERL_MAGIC_backref);
+
+           if (mg) {
+               /* Aha. They've got it stowed in magic.  Bring it back.  */
+               av = MUTABLE_AV(mg->mg_obj);
+               /* Stop mg_free decreasing the refernce count.  */
+               mg->mg_obj = NULL;
+               /* Stop mg_free even calling the destructor, given that
+                  there's no AV to free up.  */
+               mg->mg_virtual = 0;
+               sv_unmagic(tsv, PERL_MAGIC_backref);
+           } else {
+               av = newAV();
+               AvREAL_off(av);
+               SvREFCNT_inc_simple_void(av); /* see discussion above */
+           }
            *avp = av;
        }
     } else {
@@ -5419,10 +5435,10 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
 
     PERL_ARGS_ASSERT_SV_KILL_BACKREFS;
 
+    assert(!svp || !SvIS_FREED(av));
     if (svp) {
        SV *const *const last = svp + AvFILLp(av);
 
-       assert(!SvIS_FREED(av));
        while (svp <= last) {
            if (*svp) {
                SV *const referrer = *svp;
@@ -5467,7 +5483,6 @@ Perl_sv_kill_backrefs(pTHX_ SV *const sv, AV *const av)
            }
            svp++;
        }
-       AvFILLp(av) = -1;
     }
     SvREFCNT_dec(av); /* remove extra count added by sv_add_backref() */
     return 0;
@@ -5829,6 +5844,7 @@ Perl_sv_clear(pTHX_ register SV *const sv)
        if (PL_last_swash_hv == (const HV *)sv) {
            PL_last_swash_hv = NULL;
        }
+       Perl_hv_kill_backrefs(aTHX_ MUTABLE_HV(sv));
        hv_undef(MUTABLE_HV(sv));
        break;
     case SVt_PVAV: