Automatically set HINT_LOCALIZE_HH whenever %^H is modified.

[p5sagit/p5-mst-13.2.git] / hv.c

diff --git a/hv.c b/hv.c
index 8227eca..fe74e87 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1491,6 +1491,39 @@ Perl_newHVhv(pTHX_ HV *ohv)
     return hv;
 }
 
+/* A rather specialised version of newHVhv for copying %^H, ensuring all the
+   magic stays on it.  */
+HV *
+Perl_hv_copy_hints_hv(pTHX_ HV *const ohv)
+{
+    HV * const hv = newHV();
+    STRLEN hv_fill;
+
+    if (ohv && (hv_fill = HvFILL(ohv))) {
+       STRLEN hv_max = HvMAX(ohv);
+       HE *entry;
+       const I32 riter = HvRITER_get(ohv);
+       HE * const eiter = HvEITER_get(ohv);
+
+       while (hv_max && hv_max + 1 >= hv_fill * 2)
+           hv_max = hv_max / 2;
+       HvMAX(hv) = hv_max;
+
+       hv_iterinit(ohv);
+       while ((entry = hv_iternext_flags(ohv, 0))) {
+           SV *const sv = newSVsv(HeVAL(entry));
+           sv_magic(sv, NULL, PERL_MAGIC_hintselem,
+                    (char *)newSVhek (HeKEY_hek(entry)), HEf_SVKEY);
+           hv_store_flags(hv, HeKEY(entry), HeKLEN(entry),
+                          sv, HeHASH(entry), HeKFLAGS(entry));
+       }
+       HvRITER_set(ohv, riter);
+       HvEITER_set(ohv, eiter);
+    }
+    hv_magic(hv, NULL, PERL_MAGIC_hints);
+    return hv;
+}
+
 void
 Perl_hv_free_ent(pTHX_ HV *hv, register HE *entry)
 {
@@ -2590,9 +2623,7 @@ Perl_refcounted_he_chain_2hv(pTHX_ const struct refcounted_he *chain)
        flags, but it's probably not worth it, as this per-hash flag is only
        really meant as an optimisation for things like Storable.  */
     HvHASKFLAGS_on(hv);
-#ifdef DEBUGGING
-    Perl_hv_assert(aTHX_ hv);
-#endif
+    DEBUG_A(Perl_hv_assert(aTHX_ hv));
 
     return hv;
 }
@@ -2695,6 +2726,39 @@ Perl_refcounted_he_dup(pTHX_ const struct refcounted_he *const he,
     copy->refcounted_he_refcnt = he->refcounted_he_refcnt;
     return copy;
 }
+
+/*
+=for apidoc refcounted_he_copy
+
+Copies a chain of C<struct refcounted_he *>. Used by C<pp_entereval>.
+
+=cut
+*/
+
+struct refcounted_he *
+Perl_refcounted_he_copy(pTHX_ const struct refcounted_he * he)
+{
+    struct refcounted_he *copy;
+    HEK *hek;
+    /* This is much easier to express recursively than iteratively.  */
+    if (!he)
+       return NULL;
+
+    Newx(copy, 1, struct refcounted_he);
+    copy->refcounted_he_he.hent_next
+       = (HE *)Perl_refcounted_he_copy(aTHX_
+                                      (struct refcounted_he *)
+                                      he->refcounted_he_he.hent_next);
+    copy->refcounted_he_he.he_valu.hent_val
+       = newSVsv(he->refcounted_he_he.he_valu.hent_val);
+    hek = he->refcounted_he_he.hent_hek;
+    copy->refcounted_he_he.hent_hek
+       = share_hek(HEK_KEY(hek),
+                   HEK_UTF8(hek) ? -(I32)HEK_LEN(hek) : HEK_LEN(hek),
+                   HEK_HASH(hek));
+    copy->refcounted_he_refcnt = 1;
+    return copy;
+}
 #endif
 
 /*