This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
regcomp.c: Rename static fcn to better reflect its purpose
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 9c5670b..c4cf736 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -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
 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
 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
@@ -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.
 =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
 */
 
 =cut
 */
@@ -1563,6 +1569,8 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     xhv = (XPVHV*)SvANY(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;
     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);
     }
             mro_isa_changed_in(hv);
        HvEITER_set(hv, NULL);
     }
+    LEAVE;
 }
 
 /*
 }
 
 /*
@@ -1760,10 +1769,14 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 /*
 =for apidoc hv_undef
 
 /*
 =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.
 
 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
 See also L</hv_clear>.
 
 =cut
@@ -1775,6 +1788,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
     dVAR;
     register XPVHV* xhv;
     const char *name;
     dVAR;
     register XPVHV* xhv;
     const char *name;
+    const bool save = !!SvREFCNT(hv);
 
     if (!hv)
        return;
 
     if (!hv)
        return;
@@ -1799,6 +1813,10 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
                            );
        hv_name_set(hv, NULL, 0, 0);
     }
                            );
        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);
     hfreeentries(hv);
     if (SvOOK(hv)) {
       struct xpvhv_aux * const aux = HvAUX(hv);
@@ -1848,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;
     }
        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 (SvRMAGICAL(hv))
        mg_clear(MUTABLE_SV(hv));
+    if (save) LEAVE;
 }
 
 /*
 }
 
 /*
@@ -2307,7 +2329,7 @@ The C<flags> value will normally be zero; if HV_ITERNEXT_WANTPLACEHOLDERS is
 set the placeholders keys (for restricted hashes) will be returned in addition
 to normal keys. By default placeholders are automatically skipped over.
 Currently a placeholder is implemented with a value that is
 set the placeholders keys (for restricted hashes) will be returned in addition
 to normal keys. By default placeholders are automatically skipped over.
 Currently a placeholder is implemented with a value that is
-C<&Perl_sv_placeholder>.  Note that the implementation of placeholders and
+C<&PL_sv_placeholder>.  Note that the implementation of placeholders and
 restricted hashes may change, and the implementation currently is
 insufficiently abstracted for any change to be tidy.
 
 restricted hashes may change, and the implementation currently is
 insufficiently abstracted for any change to be tidy.
 
@@ -3046,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
            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;
 }
     }
     return flags & REFCOUNTED_HE_EXISTS ? NULL : &PL_sv_placeholder;
 }
@@ -3495,8 +3516,8 @@ Perl_hv_assert(pTHX_ HV *hv)
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
  * Local variables:
  * c-indentation-style: bsd
  * c-basic-offset: 4
- * indent-tabs-mode: t
+ * indent-tabs-mode: nil
  * End:
  *
  * End:
  *
- * ex: set ts=8 sts=4 sw=4 noet:
+ * ex: set ts=8 sts=4 sw=4 et:
  */
  */