This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Make CBuilder and ParseXS clean up their temp test files
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index f4c5422..06e3a47 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -33,7 +33,7 @@ holds the key and hash value.
 
 #define HV_MAX_LENGTH_BEFORE_SPLIT 14
 
-static const char *const S_strtab_error
+static const char S_strtab_error[]
     = "Cannot modify shared string table in hv_%s";
 
 STATIC void
@@ -41,7 +41,7 @@ S_more_he(pTHX)
 {
     HE* he;
     HE* heend;
-    New(54, he, PERL_ARENA_SIZE/sizeof(HE), HE);
+    Newx(he, PERL_ARENA_SIZE/sizeof(HE), HE);
     HeNEXT(he) = PL_he_arenaroot;
     PL_he_arenaroot = he;
 
@@ -54,6 +54,13 @@ S_more_he(pTHX)
     HeNEXT(he) = 0;
 }
 
+#ifdef PURIFY
+
+#define new_HE() (HE*)safemalloc(sizeof(HE))
+#define del_HE(p) safefree((char*)p)
+
+#else
+
 STATIC HE*
 S_new_he(pTHX)
 {
@@ -67,24 +74,16 @@ S_new_he(pTHX)
     return he;
 }
 
-STATIC void
-S_del_he(pTHX_ HE *p)
-{
-    LOCK_SV_MUTEX;
-    HeNEXT(p) = (HE*)PL_he_root;
-    PL_he_root = p;
-    UNLOCK_SV_MUTEX;
-}
-
-#ifdef PURIFY
-
-#define new_HE() (HE*)safemalloc(sizeof(HE))
-#define del_HE(p) safefree((char*)p)
+#define new_HE() new_he()
+#define del_HE(p) \
+    STMT_START { \
+       LOCK_SV_MUTEX; \
+       HeNEXT(p) = (HE*)PL_he_root; \
+       PL_he_root = p; \
+       UNLOCK_SV_MUTEX; \
+    } STMT_END
 
-#else
 
-#define new_HE() new_he()
-#define del_HE(p) del_he(p)
 
 #endif
 
@@ -95,7 +94,7 @@ S_save_hek_flags(pTHX_ const char *str, I32 len, U32 hash, int flags)
     char *k;
     register HEK *hek;
 
-    New(54, k, HEK_BASESIZE + len + 2, char);
+    Newx(k, HEK_BASESIZE + len + 2, char);
     hek = (HEK*)k;
     Copy(str, HEK_KEY(hek), len, char);
     HEK_KEY(hek)[len] = 0;
@@ -164,7 +163,7 @@ Perl_he_dup(pTHX_ HE *e, bool shared, CLONE_PARAMS* param)
     HeNEXT(ret) = he_dup(HeNEXT(e),shared, param);
     if (HeKLEN(e) == HEf_SVKEY) {
        char *k;
-       New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+       Newx(k, HEK_BASESIZE + sizeof(SV*), char);
        HeKEY_hek(ret) = (HEK*)k;
        HeKEY_sv(ret) = SvREFCNT_inc(sv_dup(HeKEY_sv(e), param));
     }
@@ -465,7 +464,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
                else {
                    char *k;
                    entry = new_HE();
-                   New(54, k, HEK_BASESIZE + sizeof(SV*), char);
+                   Newx(k, HEK_BASESIZE + sizeof(SV*), char);
                    HeKEY_hek(entry) = (HEK*)k;
                }
                HeNEXT(entry) = Nullhe;
@@ -542,7 +541,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #ifdef ENV_IS_CASELESS
            else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
                /* XXX This code isn't UTF8 clean.  */
-               char * const keysave = key;
+               char * const keysave = (char * const)key;
                /* Will need to free this, so set FREEKEY flag.  */
                key = savepvn(key,klen);
                key = (const char*)strupr((char*)key);
@@ -610,7 +609,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
 #endif
                                                                  ) {
            char *array;
-           Newz(503, array,
+           Newxz(array,
                 PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
                 char);
            HvARRAY(hv) = (HE**)array;
@@ -631,7 +630,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
     }
 
     if (is_utf8) {
-       char * const keysave = key;
+       char * const keysave = (char * const)key;
        key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
         if (is_utf8)
            flags |= HVhek_UTF8;
@@ -790,7 +789,7 @@ S_hv_fetch_common(pTHX_ HV *hv, SV *keysv, const char *key, STRLEN klen,
           NULL is for %ENV with dynamic env fetch.  But that should disappear
           with magic in the previous code.  */
        char *array;
-       Newz(503, array,
+       Newxz(array,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
        HvARRAY(hv) = (HE**)array;
@@ -1156,7 +1155,7 @@ S_hsplit(pTHX_ HV *hv)
        Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
     }
 #else
-    New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+    Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
        + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
     if (!a) {
       PL_nomemok = FALSE;
@@ -1234,7 +1233,7 @@ S_hsplit(pTHX_ HV *hv)
       longest_chain, HvTOTALKEYS(hv), HvFILL(hv),  1+HvMAX(hv));*/
 
     ++newsize;
-    Newz(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+    Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
         + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
     if (SvOOK(hv)) {
        Copy(HvAUX(hv), &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
@@ -1262,7 +1261,7 @@ S_hsplit(pTHX_ HV *hv)
 
            if (was_shared) {
                /* Unshare it.  */
-               HEK *new_hek
+               HEK * const new_hek
                    = save_hek_flags(HeKEY(entry), HeKLEN(entry),
                                     hash, HeKFLAGS(entry));
                unshare_hek (HeKEY_hek(entry));
@@ -1326,7 +1325,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
            Copy(&a[oldsize * sizeof(HE*)], &a[newsize * sizeof(HE*)], 1, struct xpvhv_aux);
        }
 #else
-       New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
+       Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize)
            + (SvOOK(hv) ? sizeof(struct xpvhv_aux) : 0), char);
        if (!a) {
          PL_nomemok = FALSE;
@@ -1348,7 +1347,7 @@ Perl_hv_ksplit(pTHX_ HV *hv, IV newmax)
        Zero(&a[oldsize * sizeof(HE*)], (newsize-oldsize) * sizeof(HE*), char); /* zero 2nd half*/
     }
     else {
-       Newz(0, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
+       Newxz(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
     }
     xhv->xhv_max = --newsize;  /* HvMAX(hv) = --newsize */
     HvARRAY(hv) = (HE **) a;
@@ -1418,14 +1417,15 @@ Perl_newHVhv(pTHX_ HV *ohv)
        /* It's an ordinary hash, so copy it fast. AMS 20010804 */
        STRLEN i;
        const bool shared = !!HvSHAREKEYS(ohv);
-       HE **ents, **oents = (HE **)HvARRAY(ohv);
+       HE **ents, ** const oents = (HE **)HvARRAY(ohv);
        char *a;
-       New(0, a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
+       Newx(a, PERL_HV_ARRAY_ALLOC_BYTES(hv_max+1), char);
        ents = (HE**)a;
 
        /* In each bucket... */
        for (i = 0; i <= hv_max; i++) {
-           HE *prev = NULL, *ent = NULL, *oent = oents[i];
+           HE *prev = NULL, *ent = NULL;
+           HE *oent = oents[i];
 
            if (!oent) {
                ents[i] = NULL;
@@ -1433,7 +1433,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
            }
 
            /* Copy the linked list of entries. */
-           for (oent = oents[i]; oent; oent = HeNEXT(oent)) {
+           for (; oent; oent = HeNEXT(oent)) {
                const U32 hash   = HeHASH(oent);
                const char * const key = HeKEY(oent);
                const STRLEN len = HeKLEN(oent);
@@ -1457,7 +1457,7 @@ Perl_newHVhv(pTHX_ HV *ohv)
        HvFILL(hv)  = hv_fill;
        HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
        HvARRAY(hv) = ents;
-    }
+    } /* not magical */
     else {
        /* Iterate over ohv, copying keys and values one at a time. */
        HE *entry;
@@ -1509,18 +1509,12 @@ Perl_hv_delayfree_ent(pTHX_ HV *hv, register HE *entry)
 {
     if (!entry)
        return;
-    if (isGV(HeVAL(entry)) && GvCVu(HeVAL(entry)) && HvNAME_get(hv))
-       PL_sub_generation++;    /* may be deletion of method from stash */
-    sv_2mortal(HeVAL(entry));  /* free between statements */
+    /* SvREFCNT_inc to counter the SvREFCNT_dec in hv_free_ent  */
+    sv_2mortal(SvREFCNT_inc(HeVAL(entry)));    /* free between statements */
     if (HeKLEN(entry) == HEf_SVKEY) {
-       sv_2mortal(HeKEY_sv(entry));
-       Safefree(HeKEY_hek(entry));
+       sv_2mortal(SvREFCNT_inc(HeKEY_sv(entry)));
     }
-    else if (HvSHAREKEYS(hv))
-       unshare_hek(HeKEY_hek(entry));
-    else
-       Safefree(HeKEY_hek(entry));
-    del_HE(entry);
+    hv_free_ent(hv, entry);
 }
 
 /*
@@ -1654,8 +1648,7 @@ S_hfreeentries(pTHX_ HV *hv)
     I32 riter;
     I32 max;
     struct xpvhv_aux *iter;
-    if (!hv)
-       return;
+
     if (!HvARRAY(hv))
        return;
 
@@ -1675,7 +1668,7 @@ S_hfreeentries(pTHX_ HV *hv)
     entry = array[0];
     for (;;) {
        if (entry) {
-           register HE *oentry = entry;
+           register HE * const oentry = entry;
            entry = HeNEXT(entry);
            hv_free_ent(hv, oentry);
        }
@@ -1737,7 +1730,7 @@ Perl_hv_undef(pTHX_ HV *hv)
     if ((name = HvNAME_get(hv))) {
         if(PL_stashcache)
            hv_delete(PL_stashcache, name, HvNAMELEN_get(hv), G_DISCARD);
-       Perl_hv_name_set(aTHX_ hv, 0, 0, 0);
+       Perl_hv_name_set(aTHX_ hv, Nullch, 0, 0);
     }
     SvFLAGS(hv) &= ~SVf_OOK;
     Safefree(HvARRAY(hv));
@@ -1755,7 +1748,7 @@ S_hv_auxinit(pTHX_ HV *hv) {
     char *array;
 
     if (!HvARRAY(hv)) {
-       Newz(0, array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
+       Newxz(array, PERL_HV_ARRAY_ALLOC_BYTES(HvMAX(hv) + 1)
            + sizeof(struct xpvhv_aux), char);
     } else {
        array = (char *) HvARRAY(hv);
@@ -1879,7 +1872,8 @@ Perl_hv_name_set(pTHX_ HV *hv, const char *name, I32 len, int flags)
 {
     struct xpvhv_aux *iter;
     U32 hash;
-    (void)flags;
+
+    PERL_UNUSED_ARG(flags);
 
     if (SvOOK(hv)) {
        iter = HvAUX(hv);
@@ -1970,7 +1964,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
            /* one HE per MAGICAL hash */
            iter->xhv_eiter = entry = new_HE(); /* HvEITER(hv) = new_HE() */
            Zero(entry, 1, HE);
-           Newz(54, k, HEK_BASESIZE + sizeof(SV*), char);
+           Newxz(k, HEK_BASESIZE + sizeof(SV*), char);
            hek = (HEK*)k;
            HeKEY_hek(entry) = hek;
            HeKLEN(entry) = HEf_SVKEY;
@@ -2183,7 +2177,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     bool found = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
-    const char *save = str;
+    const char * const save = str;
     struct shared_he *he = 0;
 
     if (hek) {
@@ -2282,7 +2276,7 @@ Perl_share_hek(pTHX_ const char *str, I32 len, register U32 hash)
 {
     bool is_utf8 = FALSE;
     int flags = 0;
-    const char *save = str;
+    const char * const save = str;
 
     if (len < 0) {
       STRLEN tmplen = -len;
@@ -2351,7 +2345,7 @@ S_share_hek_flags(pTHX_ const char *str, I32 len, register U32 hash, int flags)
           HEK directly from the HE.
        */
 
-       New(0, k, STRUCT_OFFSET(struct shared_he,
+       Newx(k, STRUCT_OFFSET(struct shared_he,
                                shared_he_hek.hek_key[0]) + len + 2, char);
        new_entry = (struct shared_he *)k;
        entry = &(new_entry->shared_he_he);