This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Increase stylistic consistency in perldelta by adding C<> and F<>.
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 0d296a4..a230c16 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1003,7 +1003,8 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                Safefree(key);
            return NULL;
        }
-       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+       if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))
+        && !SvIsCOW(HeVAL(entry))) {
            hv_notallowed(k_flags, key, klen,
                            "Attempt to delete readonly key '%"SVf"' from"
                            " a restricted hash");
@@ -1040,12 +1041,18 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                    mro_changes = 1;
        }
 
-       if (d_flags & G_DISCARD)
-           sv = NULL;
-       else {
-           sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_placeholder;
-       }
+       if (d_flags & G_DISCARD) {
+           sv = HeVAL(entry);
+           if (sv) {
+               /* deletion of method from stash */
+               if (isGV(sv) && isGV_with_GP(sv) && GvCVu(sv)
+                && HvENAME_get(hv))
+                   mro_method_changed_in(hv);
+               SvREFCNT_dec(sv);
+               sv = NULL;
+           }
+       } else sv = sv_2mortal(HeVAL(entry));
+       HeVAL(entry) = &PL_sv_placeholder;
 
        /*
         * If a restricted hash, rather than really deleting the entry, put
@@ -1053,18 +1060,20 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         * we can still access via not-really-existing key without raising
         * an error.
         */
-       if (SvREADONLY(hv)) {
-           SvREFCNT_dec(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_placeholder;
+       if (SvREADONLY(hv))
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
            HvPLACEHOLDERS(hv)++;
-       else {
+       else {
            *oentry = HeNEXT(entry);
            if (SvOOK(hv) && entry == HvAUX(hv)->xhv_eiter /* HvEITER(hv) */)
                HvLAZYDEL_on(hv);
-           else
+           else {
+               if (SvOOK(hv) && HvLAZYDEL(hv) &&
+                   entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+                   HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
                hv_free_ent(hv, entry);
+           }
            xhv->xhv_keys--; /* HvTOTALKEYS(hv)-- */
            if (xhv->xhv_keys == 0)
                HvHASKFLAGS_off(hv);
@@ -1519,7 +1528,8 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 /*
 =for apidoc hv_clear
 
-Clears a hash, making it empty.
+Frees the all the elements of a hash, leaving it empty.
+The XS equivalent of %hash = (). See also L</hv_undef>.
 
 =cut
 */
@@ -1544,7 +1554,8 @@ Perl_hv_clear(pTHX_ HV *hv)
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
                if (HeVAL(entry) != &PL_sv_placeholder) {
-                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+                   if (HeVAL(entry) && SvREADONLY(HeVAL(entry))
+                    && !SvIsCOW(HeVAL(entry))) {
                        SV* const keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
                                   "Attempt to delete readonly key '%"SVf"' from a restricted hash",
@@ -1622,8 +1633,12 @@ S_clear_placeholders(pTHX_ HV *hv, U32 items)
                *oentry = HeNEXT(entry);
                if (entry == HvEITER_get(hv))
                    HvLAZYDEL_on(hv);
-               else
+               else {
+                   if (SvOOK(hv) && HvLAZYDEL(hv) &&
+                       entry == HeNEXT(HvAUX(hv)->xhv_eiter))
+                       HeNEXT(HvAUX(hv)->xhv_eiter) = HeNEXT(entry);
                    hv_free_ent(hv, entry);
+               }
 
                if (--items == 0) {
                    /* Finished.  */
@@ -1647,15 +1662,12 @@ STATIC void
 S_hfreeentries(pTHX_ HV *hv)
 {
     STRLEN index = 0;
-    SV* sv;
+    XPVHV * const xhv = (XPVHV*)SvANY(hv);
 
     PERL_ARGS_ASSERT_HFREEENTRIES;
 
-    if (!((XPVHV*)SvANY(hv))->xhv_keys)
-       return;
-
-    while ( ((sv = Perl_hfree_next_entry(aTHX_ hv, &index))) ) {
-       SvREFCNT_dec(sv);
+    while (xhv->xhv_keys) {
+       SvREFCNT_dec(Perl_hfree_next_entry(aTHX_ hv, &index));
     }
 }
 
@@ -1663,7 +1675,9 @@ S_hfreeentries(pTHX_ HV *hv)
 /* hfree_next_entry()
  * For use only by S_hfreeentries() and sv_clear().
  * Delete the next available HE from hv and return the associated SV.
- * Returns null on empty hash.
+ * Returns null on empty hash. Nevertheless null is not a reliable
+ * indicator that the hash is empty, as the deleted entry may have a
+ * null value.
  * indexp is a pointer to the current index into HvARRAY. The index should
  * initially be set to 0. hfree_next_entry() may update it.  */
 
@@ -1679,9 +1693,6 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 
     PERL_ARGS_ASSERT_HFREE_NEXT_ENTRY;
 
-    if (!((XPVHV*)SvANY(hv))->xhv_keys)
-       return NULL;
-
     if (SvOOK(hv) && ((iter = HvAUX(hv)))
        && ((entry = iter->xhv_eiter)) )
     {
@@ -1697,6 +1708,9 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
        iter->xhv_eiter = NULL; /* HvEITER(hv) = NULL */
     }
 
+    if (!((XPVHV*)SvANY(hv))->xhv_keys)
+       return NULL;
+
     array = HvARRAY(hv);
     assert(array);
     while ( ! ((entry = array[*indexp])) ) {
@@ -1728,7 +1742,11 @@ Perl_hfree_next_entry(pTHX_ HV *hv, STRLEN *indexp)
 /*
 =for apidoc hv_undef
 
-Undefines the hash.
+Undefines the hash.  The XS equivalent of 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.
+See also L</hv_clear>.
 
 =cut
 */
@@ -1753,6 +1771,8 @@ Perl_hv_undef_flags(pTHX_ HV *hv, U32 flags)
        allocate an array for storing the effective name. We can skip that
        during global destruction, as it does not matter where the CVs point
        if they will be freed anyway. */
+    /* note that the code following prior to hfreeentries is duplicated
+     * in sv_clear(), and changes here should be done there too */
     if (PL_phase != PERL_PHASE_DESTRUCT && (name = HvNAME(hv))) {
         if (PL_stashcache)
            (void)hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
@@ -3257,6 +3277,7 @@ to this function: no action occurs and a null pointer is returned.
 struct refcounted_he *
 Perl_refcounted_he_inc(pTHX_ struct refcounted_he *he)
 {
+    dVAR;
     if (he) {
        HINTS_REFCNT_LOCK;
        he->refcounted_he_refcnt++;