X-Git-Url: https://perl5.git.perl.org/perl5.git/blobdiff_plain/db4fbf16f81968637095420c2f968de1d2519030..59f4a9a341b78358835e8023bd17b6faaf0d1186:/hv.c?ds=sidebyside

diff --git a/hv.c b/hv.c
index 9c5670b..c4cf736 100644
--- 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
-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
@@ -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
 */
@@ -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;
 }
 
 /*
@@ -1760,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
@@ -1775,6 +1788,7 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
     dVAR;
     register XPVHV* xhv;
     const char *name;
+    const bool save = !!SvREFCNT(hv);
 
     if (!hv)
 	return;
@@ -1799,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);
@@ -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;
     }
-    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;
 }
 
 /*
@@ -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
-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.
 
@@ -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
-	)
-	    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;
 }
@@ -3495,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:
  */