This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Refactor t/porting/checkcase.t to use test.pl instead of making TAP by hand.
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 2cfe25b..b5e3d91 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -78,7 +78,7 @@ S_save_hek_flags(const char *str, I32 len, U32 hash, int flags)
 {
     const int flags_masked = flags & HVhek_MASK;
     char *k;
-    register HEK *hek;
+    HEK *hek;
 
     PERL_ARGS_ASSERT_SAVE_HEK_FLAGS;
 
@@ -277,7 +277,10 @@ negative the key is assumed to be in UTF-8-encoded Unicode.
 Returns the SV which corresponds to the specified key in the hash.
 The absolute value of C<klen> is the length of the key.  If C<klen> is
 negative the key is assumed to be in UTF-8-encoded Unicode.  If
-C<lval> is set then the fetch will be part of a store.  Check that the
+C<lval> is set then the fetch will be part of a store.  This means that if
+there is no value in the hash associated with the given key, then one is
+created and a pointer to it is returned.  The C<SV*> it points to can be
+assigned to.  But always check that the
 return value is non-null before dereferencing it to an C<SV*>.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
@@ -907,9 +910,9 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                   int k_flags, I32 d_flags, U32 hash)
 {
     dVAR;
-    register XPVHV* xhv;
-    register HE *entry;
-    register HE **oentry;
+    XPVHV* xhv;
+    HE *entry;
+    HE **oentry;
     bool is_utf8 = (k_flags & HVhek_UTF8) ? TRUE : FALSE;
     int masked_flags;
 
@@ -1110,12 +1113,12 @@ STATIC void
 S_hsplit(pTHX_ HV *hv)
 {
     dVAR;
-    register XPVHV* const xhv = (XPVHV*)SvANY(hv);
+    XPVHV* const xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
-    register I32 newsize = oldsize * 2;
-    register I32 i;
+    I32 newsize = oldsize * 2;
+    I32 i;
     char *a = (char*) HvARRAY(hv);
-    register HE **aep;
+    HE **aep;
     int longest_chain = 0;
     int was_shared;
 
@@ -1168,7 +1171,7 @@ S_hsplit(pTHX_ HV *hv)
        int right_length = 0;
        HE **oentry = aep;
        HE *entry = *aep;
-       register HE **bep;
+       HE **bep;
 
        if (!entry)                             /* non-existent */
            continue;
@@ -1227,7 +1230,7 @@ S_hsplit(pTHX_ HV *hv)
     aep = HvARRAY(hv);
 
     for (i=0; i<newsize; i++,aep++) {
-       register HE *entry = *aep;
+       HE *entry = *aep;
        while (entry) {
            /* We're going to trash this HE's next pointer when we chain it
               into the new hash below, so store where we go next.  */
@@ -1269,12 +1272,12 @@ void
 Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
 {
     dVAR;
-    register XPVHV* xhv = (XPVHV*)SvANY(hv);
+    XPVHV* xhv = (XPVHV*)SvANY(hv);
     const I32 oldsize = (I32) xhv->xhv_max+1; /* HvMAX(hv)+1 (sick) */
-    register I32 newsize;
-    register I32 i;
-    register char *a;
-    register HE **aep;
+    I32 newsize;
+    I32 i;
+    char *a;
+    HE **aep;
 
     PERL_ARGS_ASSERT_HV_KSPLIT;
 
@@ -1334,7 +1337,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        if (!entry)                             /* non-existent */
            continue;
        do {
-           register I32 j = (HeHASH(entry) & newsize);
+           I32 j = (HeHASH(entry) & newsize);
 
            if (j != i) {
                j -= i;
@@ -1546,7 +1549,10 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 =for apidoc hv_clear
 
 Frees the all the elements of a hash, leaving it empty.
-The XS equivalent of %hash = (). See also L</hv_undef>.
+The XS equivalent of C<%hash = ()>.  See also L</hv_undef>.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
 
 =cut
 */
@@ -1555,7 +1561,7 @@ void
 Perl_hv_clear(pTHX_ HV *hv)
 {
     dVAR;
-    register XPVHV* xhv;
+    XPVHV* xhv;
     if (!hv)
        return;
 
@@ -1563,6 +1569,8 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     xhv = (XPVHV*)SvANY(hv);
 
+    ENTER;
+    SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
     if (SvREADONLY(hv) && HvARRAY(hv) != NULL) {
        /* restricted hash: convert all keys to placeholders */
        STRLEN i;
@@ -1600,6 +1608,7 @@ Perl_hv_clear(pTHX_ HV *hv)
             mro_isa_changed_in(hv);
        HvEITER_set(hv, NULL);
     }
+    LEAVE;
 }
 
 /*
@@ -1681,20 +1690,12 @@ S_hfreeentries(pTHX_ HV *hv)
     STRLEN index = 0;
     XPVHV * const xhv = (XPVHV*)SvANY(hv);
     SV *sv;
-    const bool save = !!SvREFCNT(hv);
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
-    if (save) {
-       ENTER;
-       SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
-    }
-
     while ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))||xhv->xhv_keys) {
        SvREFCNT_dec(sv);
     }
-
-    if (save) LEAVE;
 }
 
 
@@ -1768,10 +1769,14 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 /*
 =for apidoc hv_undef
 
-Undefines the hash.  The XS equivalent of undef(%hash).
+Undefines the hash.  The XS equivalent of C<undef(%hash)>.
 
 As well as freeing all the elements of the hash (like hv_clear()), this
 also frees any auxiliary data and storage associated with the hash.
+
+If any destructors are triggered as a result, the hv itself may
+be freed.
+
 See also L</hv_clear>.
 
 =cut
@@ -1781,8 +1786,9 @@ void
 Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
 {
     dVAR;
-    register XPVHV* xhv;
+    XPVHV* xhv;
     const char *name;
+    const bool save = !!SvREFCNT(hv);
 
     if (!hv)
        return;
@@ -1807,6 +1813,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
                            );
        hv_name_set(hv, NULL, 0, 0);
     }
+    if (save) {
+       ENTER;
+       SAVEFREESV(SvREFCNT_inc_simple_NN(hv));
+    }
     hfreeentries(hv);
     if (SvOOK(hv)) {
       struct xpvhv_aux * const aux = HvAUX(hv);
@@ -1856,10 +1866,14 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
        xhv->xhv_max   = 7;     /* HvMAX(hv) = 7 (it's a normal hash) */
        HvARRAY(hv) = 0;
     }
-    HvPLACEHOLDERS_set(hv, 0);
+    /* if we're freeing the HV, the SvMAGIC field has been reused for
+     * other purposes, and so there can't be any placeholder magic */
+    if (SvREFCNT(hv))
+       HvPLACEHOLDERS_set(hv, 0);
 
     if (SvRMAGICAL(hv))
        mg_clear(MUTABLE_SV(hv));
+    if (save) LEAVE;
 }
 
 /*
@@ -2326,8 +2340,8 @@ HE *
 Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
 {
     dVAR;
-    register XPVHV* xhv;
-    register HE *entry;
+    XPVHV* xhv;
+    HE *entry;
     HE *oldentry;
     MAGIC* mg;
     struct xpvhv_aux *iter;
@@ -2582,9 +2596,9 @@ STATIC void
 S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
 {
     dVAR;
-    register XPVHV* xhv;
+    XPVHV* xhv;
     HE *entry;
-    register HE **oentry;
+    HE **oentry;
     bool is_utf8 = FALSE;
     int k_flags = 0;
     const char * const save = str;
@@ -2704,10 +2718,10 @@ STATIC HEK *
 S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
 {
     dVAR;
-    register HE *entry;
+    HE *entry;
     const int flags_masked = flags & HVhek_MASK;
     const U32 hindex = hash & (I32) HvMAX(PL_strtab);
-    register XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
+    XPVHV * const xhv = (XPVHV*)SvANY(PL_strtab);
 
     PERL_ARGS_ASSERT_SHARE_HEK_FLAGS;
 
@@ -3054,14 +3068,13 @@ Perl_refcounted_he_fetch_pvn(pTHX_ const struct refcounted_he *chain,
            memEQ(HEK_KEY(chain->refcounted_he_hek), keypv, keylen) &&
            utf8_flag == (HEK_FLAGS(chain->refcounted_he_hek) & HVhek_UTF8)
 #endif
-       )
-           return
-               flags & REFCOUNTED_HE_EXISTS
-                   ? (chain->refcounted_he_data[0] & HVrhek_typemask)
-                       == HVrhek_delete
-                      ? NULL
-                      : &PL_sv_yes
-                   : sv_2mortal(refcounted_he_value(chain));
+       ) {
+           if (flags & REFCOUNTED_HE_EXISTS)
+               return (chain->refcounted_he_data[0] & HVrhek_typemask)
+                   == HVrhek_delete
+                   ? NULL : &PL_sv_yes;
+           return sv_2mortal(refcounted_he_value(chain));
+       }
     }
     return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder;
 }
@@ -3503,8 +3516,8 @@ Perl_hv_assert(pTHX_ HV *hv)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */