X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=hv.c;h=78082d0af4a7b884625c8cbc8ef6332276ce73b8;hb=475b40fdd42aeff1d8eaa6926314ced65a429639;hp=5abfc62eaf82934d9a46d10d7712e73050bad7ee;hpb=34c3c4e3c36afb477dacf54a0d4557360c741870;p=p5sagit%2Fp5-mst-13.2.git diff --git a/hv.c b/hv.c index 5abfc62..78082d0 100644 --- 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) @@ -310,7 +312,7 @@ S_hv_fetch_flags(pTHX_ HV *hv, const char *key, I32 klen, I32 lval, int flags) 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 +418,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 +433,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) { @@ -480,7 +482,7 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash) 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 +645,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 +653,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 +696,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 +705,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 +820,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 +964,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 +994,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 +1004,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 +1123,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 +1152,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 +1162,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 +1271,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 +1376,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 +1705,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 +1730,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 +1758,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 +1777,7 @@ S_hfreeentries(pTHX_ HV *hv) entry = array[riter]; } } + HvARRAY(hv) = array; (void)hv_iterinit(hv); } @@ -1799,8 +1806,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 +1875,8 @@ Returns entries from a hash iterator. See C and C. The C 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 value is a normal read-write SV for which -C 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 +1945,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 +1965,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