This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
HP-UX 10.20 still *needs* -Ae for HP C-ANSI-C to be ANSI
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 097b599..ca945f6 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,7 +1,7 @@
 /*    hv.c
  *
  *    Copyright (C) 1991, 1992, 1993, 1994, 1995, 1996, 1997, 1998, 1999,
- *    2000, 2001, 2002, 2003, by Larry Wall and others
+ *    2000, 2001, 2002, 2003, 2004, by Larry Wall and others
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -977,19 +977,21 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
            continue;
        if ((HeKFLAGS(entry) ^ masked_flags) & HVhek_UTF8)
            continue;
-        if (k_flags & HVhek_FREEKEY)
-            Safefree(key);
 
        /* if placeholder is here, it's already been deleted.... */
        if (HeVAL(entry) == &PL_sv_placeholder)
        {
-           return Nullsv;
+         if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
+         return Nullsv;
        }
        else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
            S_hv_notallowed(aTHX_ k_flags, key, klen,
                            "delete readonly key '%"SVf"' from"
                            );
        }
+        if (k_flags & HVhek_FREEKEY)
+            Safefree(key);
 
        if (d_flags & G_DISCARD)
            sv = Nullsv;
@@ -1005,6 +1007,7 @@ S_hv_delete_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
         * an error.
         */
        if (SvREADONLY(hv)) {
+           SvREFCNT_dec(HeVAL(entry));
            HeVAL(entry) = &PL_sv_placeholder;
            /* We'll be saving this slot, so the number of allocated keys
             * doesn't go down, but the number placeholders goes up */
@@ -1049,6 +1052,17 @@ S_hsplit(pTHX_ HV *hv)
     int longest_chain = 0;
     int was_shared;
 
+    /*PerlIO_printf(PerlIO_stderr(), "hsplit called for %p which had %d\n",
+      hv, (int) oldsize);*/
+
+    if (HvPLACEHOLDERS(hv) && !SvREADONLY(hv)) {
+      /* Can make this clear any placeholders first for non-restricted hashes,
+        even though Storable rebuilds restricted hashes by putting in all the
+        placeholders (first) before turning on the readonly flag, because
+        Storable always pre-splits the hash.  */
+      hv_clear_placeholders(hv);
+    }
+              
     PL_nomemok = TRUE;
 #if defined(STRANGE_MALLOC) || defined(MYMALLOC)
     Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
@@ -1495,7 +1509,7 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
        if (!entry)
            continue;
 
-       for (; entry; first=0, oentry = &HeNEXT(entry), entry = *oentry) {
+       for (; entry; entry = *oentry) {
            if (HeVAL(entry) == &PL_sv_placeholder) {
                *oentry = HeNEXT(entry);
                if (first && !*oentry)
@@ -1513,6 +1527,9 @@ Perl_hv_clear_placeholders(pTHX_ HV *hv)
                    HvPLACEHOLDERS(hv) = 0;
                    return;
                }
+           } else {
+               oentry = &HeNEXT(entry);
+               first = 0;
            }
        }
     } while (--i >= 0);
@@ -1999,9 +2016,10 @@ S_unshare_hek_or_pvn(pTHX_ HEK *hek, const char *str, I32 len, U32 hash)
     UNLOCK_STRTAB_MUTEX;
     if (!found && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
-                    "Attempt to free non-existent shared string '%s'%s",
+                    "Attempt to free non-existent shared string '%s'%s"
+                    pTHX__FORMAT,
                     hek ? HEK_KEY(hek) : str,
-                    (k_flags & HVhek_UTF8) ? " (utf8)" : "");
+                    ((k_flags & HVhek_UTF8) ? " (utf8)" : "") pTHX__VALUE);
     if (k_flags & HVhek_FREEKEY)
        Safefree(str);
 }