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 967ca4a..c4cf736 100644 (file)
--- a/hv.c
+++ b/hv.c
 /* 
 =head1 Hash Manipulation Functions
 
 /* 
 =head1 Hash Manipulation Functions
 
-A HV structure represents a Perl hash. It consists mainly of an array
-of pointers, each of which points to a linked list of HE structures. The
+A HV structure represents a Perl hash.  It consists mainly of an array
+of pointers, each of which points to a linked list of HE structures.  The
 array is indexed by the hash function of the key, so each linked list
 array is indexed by the hash function of the key, so each linked list
-represents all the hash entries with the same hash value. Each HE contains
+represents all the hash entries with the same hash value.  Each HE contains
 a pointer to the actual value, plus a pointer to a HEK structure which
 holds the key and hash value.
 
 a pointer to the actual value, plus a pointer to a HEK structure which
 holds the key and hash value.
 
@@ -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
@@ -285,7 +288,8 @@ information on how to use this function on tied hashes.
 
 =for apidoc hv_exists_ent
 
 
 =for apidoc hv_exists_ent
 
-Returns a boolean indicating whether the specified hash key exists. C<hash>
+Returns a boolean indicating whether
+the specified hash key exists.  C<hash>
 can be a valid precomputed hash value, or 0 to ask for it to be
 computed.
 
 can be a valid precomputed hash value, or 0 to ask for it to be
 computed.
 
@@ -1496,8 +1500,6 @@ S_hv_free_ent_ret(pTHX_ HV *hv, register HE *entry)
     if (!entry)
        return NULL;
     val = HeVAL(entry);
     if (!entry)
        return NULL;
     val = HeVAL(entry);
-    if (val && isGV(val) && isGV_with_GP(val) && GvCVu(val) && HvENAME(hv))
-        mro_method_changed_in(hv);     /* deletion of method from stash */
     if (HeKLEN(entry) == HEf_SVKEY) {
        SvREFCNT_dec(HeKEY_sv(entry));
        Safefree(HeKEY_hek(entry));
     if (HeKLEN(entry) == HEf_SVKEY) {
        SvREFCNT_dec(HeKEY_sv(entry));
        Safefree(HeKEY_hek(entry));
@@ -1547,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
 */
@@ -1564,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;
@@ -1601,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;
 }
 
 /*
 }
 
 /*
@@ -1761,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
@@ -1776,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;
@@ -1800,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);
@@ -1849,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;
 }
 
 /*
 }
 
 /*
@@ -2122,7 +2143,7 @@ hek_eq_pvn_flags(pTHX_ const HEK *hek, const char* pv, const I32 pvlen, const U3
 /*
 =for apidoc hv_ename_add
 
 /*
 =for apidoc hv_ename_add
 
-Adds a name to a stash's internal list of effective names. See
+Adds a name to a stash's internal list of effective names.  See
 C<hv_ename_delete>.
 
 This is called when a stash is assigned to a new location in the symbol
 C<hv_ename_delete>.
 
 This is called when a stash is assigned to a new location in the symbol
@@ -2183,7 +2204,7 @@ Perl_hv_ename_add(pTHX_ HV *hv, const char *name, U32 len, U32 flags)
 /*
 =for apidoc hv_ename_delete
 
 /*
 =for apidoc hv_ename_delete
 
-Removes a name from a stash's internal list of effective names. If this is
+Removes a name from a stash's internal list of effective names.  If this is
 the name returned by C<HvENAME>, then another name in the list will take
 its place (C<HvENAME> will use it).
 
 the name returned by C<HvENAME>, then another name in the list will take
 its place (C<HvENAME> will use it).
 
@@ -2308,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.
 
@@ -3047,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;
 }
@@ -3496,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:
  */
  */