This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
https://perl5.git.perl.org / perl5.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
Taint safe Cwd::_qnx_abs_path()
[perl5.git] / hv.c
diff --git a/hv.c b/hv.c
index 5abfc62..63e112a 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -279,6 +279,8 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
     for (; entry; entry = HeNEXT(entry)) {
+       if (!HeKEY_hek(entry))
+           continue;
        if (HeHASH(entry) != hash)              /* strings can't be equal */
            continue;
        if (HeKLEN(entry) != (I32)klen)
@@ -306,11 +308,13 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags)
             }
             else
                 HeKFLAGS(entry) = flags;
+            if (flags)
+                HvHASKFLAGS_on(hv);
         }
         if (flags & HVhek_FREEKEY)
             Safefree(key);
        /* if we find a placeholder, we pretend we haven't found anything */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            break;
        return &HeVAL(entry);
 
@@ -416,6 +420,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
 #endif
     }
 
+    keysave = key = SvPV(keysv, klen);
     xhv = (XPVHV*)SvANY(hv);
     if (!xhv->xhv_array /* !HvARRAY(hv) */) {
        if (lval
@@ -430,7 +435,6 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
            return 0;
     }
 
-    keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv)!=0);
 
     if (is_utf8) {
@@ -476,11 +480,13 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
             }
             else
                 HeKFLAGS(entry) = flags;
+            if (flags)
+                HvHASKFLAGS_on(hv);
         }
        if (key != keysave)
            Safefree(key);
        /* if we find a placeholder, we pretend we haven't found anything */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            break;
        return entry;
     }
@@ -643,7 +649,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
            continue;
        if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
            continue;
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
        else
            SvREFCNT_dec(HeVAL(entry));
@@ -651,7 +657,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
             /* We have been requested to insert a placeholder. Currently
                only Storable is allowed to do this.  */
             xhv->xhv_placeholders++;
-            HeVAL(entry) = &PL_sv_undef;
+            HeVAL(entry) = &PL_sv_placeholder;
         } else
             HeVAL(entry) = val;
 
@@ -694,7 +700,7 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
         /* We have been requested to insert a placeholder. Currently
            only Storable is allowed to do this.  */
         xhv->xhv_placeholders++;
-        HeVAL(entry) = &PL_sv_undef;
+        HeVAL(entry) = &PL_sv_placeholder;
     } else
         HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
@@ -703,8 +709,8 @@ Perl_hv_store_flags(pTHX_ HV *hv, const char *key, I32 klen, SV *val,
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
     if (i) {                           /* initial entry? */
        xhv->xhv_fill++; /* HvFILL(hv)++ */
-       if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
-           hsplit(hv);
+    } else if (xhv->xhv_keys > (IV)xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */) {
+        hsplit(hv);
     }
 
     return &HeVAL(entry);
@@ -818,7 +824,7 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
            continue;
        if ((HeKFLAGS(entry) ^ flags) & HVhek_UTF8)
            continue;
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
        else
            SvREFCNT_dec(HeVAL(entry));
@@ -962,7 +968,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
        /* if placeholder is here, it's already been deleted.... */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
        {
            if (SvREADONLY(hv))
                return Nullsv;  /* if still SvREADONLY, leave it deleted. */
@@ -992,7 +998,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
            sv = Nullsv;
        else {
            sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_undef;
+           HeVAL(entry) = &PL_sv_placeholder;
        }
 
        /*
@@ -1002,7 +1008,7 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
         * an error.
         */
        if (SvREADONLY(hv)) {
-           HeVAL(entry) = &PL_sv_undef;
+           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 */
            xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
@@ -1121,7 +1127,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
             Safefree(key);
 
        /* if placeholder is here, it's already been deleted.... */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
        {
            if (SvREADONLY(hv))
                return Nullsv; /* if still SvREADONLY, leave it deleted. */
@@ -1150,7 +1156,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
            sv = Nullsv;
        else {
            sv = sv_2mortal(HeVAL(entry));
-           HeVAL(entry) = &PL_sv_undef;
+           HeVAL(entry) = &PL_sv_placeholder;
        }
 
        /*
@@ -1160,7 +1166,7 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
         * an error.
         */
        if (SvREADONLY(hv)) {
-           HeVAL(entry) = &PL_sv_undef;
+           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 */
            xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
@@ -1269,7 +1275,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
        /* If we find the key, but the value is a placeholder, return false. */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            return FALSE;
 
        return TRUE;
@@ -1374,7 +1380,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
        if (k_flags & HVhek_FREEKEY)
            Safefree(key);
        /* If we find the key, but the value is a placeholder, return false. */
-       if (HeVAL(entry) == &PL_sv_undef)
+       if (HeVAL(entry) == &PL_sv_placeholder)
            return FALSE;
        return TRUE;
     }
@@ -1703,23 +1709,23 @@ Perl_hv_clear(pTHX_ HV *hv)
 
     xhv = (XPVHV*)SvANY(hv);
 
-    if(SvREADONLY(hv)) {
+    if (SvREADONLY(hv)) {
        /* restricted hash: convert all keys to placeholders */
        I32 i;
        HE* entry;
-       for (i=0; i< (I32) xhv->xhv_max; i++) {
+       for (i = 0; i <= (I32) xhv->xhv_max; i++) {
            entry = ((HE**)xhv->xhv_array)[i];
            for (; entry; entry = HeNEXT(entry)) {
                /* not already placeholder */
-               if (HeVAL(entry) != &PL_sv_undef) {
+               if (HeVAL(entry) != &PL_sv_placeholder) {
                    if (HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
                        SV* keysv = hv_iterkeysv(entry);
                        Perl_croak(aTHX_
-               "Attempt to delete readonly key '%_' from a restricted hash",
-                               keysv);
+       "Attempt to delete readonly key '%"SVf"' from a restricted hash",
+                                  keysv);
                    }
                    SvREFCNT_dec(HeVAL(entry));
-                   HeVAL(entry) = &PL_sv_undef;
+                   HeVAL(entry) = &PL_sv_placeholder;
                    xhv->xhv_placeholders++; /* HvPLACEHOLDERS(hv)++ */
                }
            }
@@ -1728,8 +1734,6 @@ Perl_hv_clear(pTHX_ HV *hv)
     }
 
     hfreeentries(hv);
-    xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
-    xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
     if (xhv->xhv_array /* HvARRAY(hv) */)
        (void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
@@ -1758,6 +1762,12 @@ S_hfreeentries(pTHX_ HV *hv)
     riter = 0;
     max = HvMAX(hv);
     array = HvARRAY(hv);
+    /* make everyone else think the array is empty, so that the destructors
+     * called for freed entries can't recusively mess with us */
+    HvARRAY(hv) = Null(HE**); 
+    HvFILL(hv) = 0;
+    ((XPVHV*) SvANY(hv))->xhv_keys = 0;
+
     entry = array[0];
     for (;;) {
        if (entry) {
@@ -1771,6 +1781,7 @@ S_hfreeentries(pTHX_ HV *hv)
            entry = array[riter];
        }
     }
+    HvARRAY(hv) = array;
     (void)hv_iterinit(hv);
 }
 
@@ -1799,8 +1810,6 @@ Perl_hv_undef(pTHX_ HV *hv)
     }
     xhv->xhv_max   = 7;        /* HvMAX(hv) = 7 (it's a normal hash) */
     xhv->xhv_array = 0;        /* HvARRAY(hv) = 0 */
-    xhv->xhv_fill  = 0;        /* HvFILL(hv) = 0 */
-    xhv->xhv_keys  = 0;        /* HvKEYS(hv) = 0 */
     xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
 
     if (SvRMAGICAL(hv))
@@ -1870,9 +1879,8 @@ Returns entries from a hash iterator.  See C<hv_iterinit> and C<hv_iternext>.
 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 literally
-<&Perl_sv_undef> (a regular C<undef> value is a normal read-write SV for which
-C<!SvOK> is false). Note that the implementation of placeholders and
+Currently a placeholder is implemented with a value that is
+C<&Perl_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.
 
@@ -1941,7 +1949,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
              * Skip past any placeholders -- don't want to include them in
              * any iteration.
              */
-            while (entry && HeVAL(entry) == &PL_sv_undef) {
+            while (entry && HeVAL(entry) == &PL_sv_placeholder) {
                 entry = HeNEXT(entry);
             }
        }
@@ -1961,7 +1969,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
             /* If we have an entry, but it's a placeholder, don't count it.
               Try the next.  */
-           while (entry && HeVAL(entry) == &PL_sv_undef)
+           while (entry && HeVAL(entry) == &PL_sv_placeholder)
                entry = HeNEXT(entry);
        }
        /* Will loop again if this linked list starts NULL
Unnamed repository; edit this file 'description' to name the repository.