HE* he;
LOCK_SV_MUTEX;
if (!PL_he_root)
- more_he();
+ more_he();
he = PL_he_root;
PL_he_root = HeNEXT(he);
UNLOCK_SV_MUTEX;
heend = &he[1008 / sizeof(HE) - 1];
PL_he_root = ++he;
while (he < heend) {
- HeNEXT(he) = (HE*)(he + 1);
- he++;
+ HeNEXT(he) = (HE*)(he + 1);
+ he++;
}
HeNEXT(he) = 0;
}
if (!xhv->xhv_array /* !HvARRAY(hv) */) {
if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
- || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+ || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
#endif
- )
+ )
Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
continue;
if (key != keysave)
Safefree(key);
+ /* if we find a placeholder, we pretend we haven't found anything */
+ if (HeVAL(entry) == &PL_sv_undef)
+ break;
return &HeVAL(entry);
+
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
}
}
#endif
- if (SvREADONLY(hv)) {
+ if (!entry && SvREADONLY(hv)) {
Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
}
if (lval) { /* gonna assign to this, so it better be there */
if (!xhv->xhv_array /* !HvARRAY(hv) */) {
if (lval
#ifdef DYNAMIC_ENV_FETCH /* if it's an %ENV lookup, we may get it on the fly */
- || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
+ || (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env))
#endif
- )
+ )
Newz(503, xhv->xhv_array /* HvARRAY(hv) */,
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
continue;
if (key != keysave)
Safefree(key);
+ /* if we find a placeholder, we pretend we haven't found anything */
+ if (HeVAL(entry) == &PL_sv_undef)
+ break;
return entry;
}
#ifdef DYNAMIC_ENV_FETCH /* %ENV lookup? If so, try to fetch the value now */
}
}
#endif
- if (SvREADONLY(hv)) {
+ if (!entry && SvREADONLY(hv)) {
Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
}
if (key != keysave)
return 0;
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
- key = savepvn(key,klen);
+ key = savepvn(key,klen);
key = (const char*)strupr((char*)key);
hash = 0;
}
continue;
if (HeKUTF8(entry) != (char)is_utf8)
continue;
- SvREFCNT_dec(HeVAL(entry));
+ if (HeVAL(entry) == &PL_sv_undef)
+ xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
+ else
+ SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
if (key != keysave)
Safefree(key);
xhv = (XPVHV*)SvANY(hv);
if (SvMAGICAL(hv)) {
- bool needs_copy;
- bool needs_store;
- hv_magic_check (hv, &needs_copy, &needs_store);
- if (needs_copy) {
- bool save_taint = PL_tainted;
- if (PL_tainting)
- PL_tainted = SvTAINTED(keysv);
- keysv = sv_2mortal(newSVsv(keysv));
- mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
- TAINT_IF(save_taint);
- if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
- return Nullhe;
+ bool needs_copy;
+ bool needs_store;
+ hv_magic_check (hv, &needs_copy, &needs_store);
+ if (needs_copy) {
+ bool save_taint = PL_tainted;
+ if (PL_tainting)
+ PL_tainted = SvTAINTED(keysv);
+ keysv = sv_2mortal(newSVsv(keysv));
+ mg_copy((SV*)hv, val, (char*)keysv, HEf_SVKEY);
+ TAINT_IF(save_taint);
+ if (!xhv->xhv_array /* !HvARRAY(hv) */ && !needs_store)
+ return Nullhe;
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
key = SvPV(keysv, klen);
continue;
if (HeKUTF8(entry) != (char)is_utf8)
continue;
- SvREFCNT_dec(HeVAL(entry));
+ if (HeVAL(entry) == &PL_sv_undef)
+ xhv->xhv_placeholders--; /* yes, can store into placeholder slot */
+ else
+ SvREFCNT_dec(HeVAL(entry));
HeVAL(entry) = val;
if (key != keysave)
Safefree(key);
key = strupr(SvPVX(sv));
}
#endif
- }
+ }
}
xhv = (XPVHV*)SvANY(hv);
if (!xhv->xhv_array /* !HvARRAY(hv) */)
klen = tmplen;
}
- if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
- }
-
PERL_HASH(hash, key, klen);
/* oentry = &(HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
continue;
if (key != keysave)
Safefree(key);
+ /* if placeholder is here, it's already been deleted.... */
+ if (HeVAL(entry) == &PL_sv_undef)
+ {
+ if (SvREADONLY(hv))
+ return Nullsv; /* if still SvREADONLY, leave it deleted. */
+ else {
+ /* okay, really delete the placeholder... */
+ *oentry = HeNEXT(entry);
+ if (i && !*oentry)
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+ HvLAZYDEL_on(hv);
+ else
+ hv_free_ent(hv, entry);
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ xhv->xhv_placeholders--;
+ return Nullsv;
+ }
+ }
+ else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--; /* HvFILL(hv)-- */
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
- HvLAZYDEL_on(hv);
- else
- hv_free_ent(hv, entry);
- xhv->xhv_keys--; /* HvKEYS(hv)-- */
+
+ /*
+ * If a restricted hash, rather than really deleting the entry, put
+ * a placeholder there. This marks the key as being "approved", so
+ * we can still access via not-really-existing key without raising
+ * an error.
+ */
+ if (SvREADONLY(hv)) {
+ HeVAL(entry) = &PL_sv_undef;
+ /* 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)++ */
+ } else {
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+ HvLAZYDEL_on(hv);
+ else
+ hv_free_ent(hv, entry);
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ }
return sv;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
if (key != keysave)
Safefree(key);
return Nullsv;
if (is_utf8)
key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
- if (SvREADONLY(hv)) {
- Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
- }
-
if (!hash)
PERL_HASH(hash, key, klen);
continue;
if (key != keysave)
Safefree(key);
+
+ /* if placeholder is here, it's already been deleted.... */
+ if (HeVAL(entry) == &PL_sv_undef)
+ {
+ if (SvREADONLY(hv))
+ return Nullsv; /* if still SvREADONLY, leave it deleted. */
+ else {
+ // okay, really delete the placeholder.
+ *oentry = HeNEXT(entry);
+ if (i && !*oentry)
+ xhv->xhv_fill--; /* HvFILL(hv)-- */
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+ HvLAZYDEL_on(hv);
+ else
+ hv_free_ent(hv, entry);
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ xhv->xhv_placeholders--;
+ return Nullsv;
+ }
+ }
+ else if (SvREADONLY(hv) && HeVAL(entry) && SvREADONLY(HeVAL(entry))) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
*oentry = HeNEXT(entry);
if (i && !*oentry)
xhv->xhv_fill--; /* HvFILL(hv)-- */
sv = sv_2mortal(HeVAL(entry));
HeVAL(entry) = &PL_sv_undef;
}
- if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
- HvLAZYDEL_on(hv);
- else
- hv_free_ent(hv, entry);
- xhv->xhv_keys--; /* HvKEYS(hv)-- */
+
+ /*
+ * If a restricted hash, rather than really deleting the entry, put
+ * a placeholder there. This marks the key as being "approved", so
+ * we can still access via not-really-existing key without raising
+ * an error.
+ */
+ if (SvREADONLY(hv)) {
+ HeVAL(entry) = &PL_sv_undef;
+ /* 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)++ */
+ } else {
+ if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+ HvLAZYDEL_on(hv);
+ else
+ hv_free_ent(hv, entry);
+ xhv->xhv_keys--; /* HvKEYS(hv)-- */
+ }
return sv;
}
+ if (SvREADONLY(hv)) {
+ Perl_hv_notallowed(aTHX_ is_utf8, key, klen, keysave);
+ }
+
if (key != keysave)
Safefree(key);
return Nullsv;
continue;
if (key != keysave)
Safefree(key);
+ /* If we find the key, but the value is a placeholder, return false. */
+ if (HeVAL(entry) == &PL_sv_undef)
+ return FALSE;
+
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
if (SvRMAGICAL(hv)) {
if (mg_find((SV*)hv, PERL_MAGIC_tied) || SvGMAGICAL((SV*)hv)) {
- SV* svret = sv_newmortal();
+ SV* svret = sv_newmortal();
sv = sv_newmortal();
keysv = sv_2mortal(newSVsv(keysv));
mg_copy((SV*)hv, sv, (char*)keysv, HEf_SVKEY);
- magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
- return SvTRUE(svret);
+ magic_existspack(svret, mg_find(sv, PERL_MAGIC_tiedelem));
+ return SvTRUE(svret);
}
#ifdef ENV_IS_CASELESS
else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
continue;
if (key != keysave)
Safefree(key);
+ /* If we find the key, but the value is a placeholder, return false. */
+ if (HeVAL(entry) == &PL_sv_undef)
+ return FALSE;
return TRUE;
}
#ifdef DYNAMIC_ENV_FETCH /* is it out there? */
PL_nomemok = TRUE;
#if defined(STRANGE_MALLOC) || defined(MYMALLOC)
Renew(a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
- if (!a) {
+ if (!a) {
PL_nomemok = FALSE;
return;
}
#else
New(2, a, PERL_HV_ARRAY_ALLOC_BYTES(newsize), char);
- if (!a) {
+ if (!a) {
PL_nomemok = FALSE;
return;
}
HvMAX(hv) = hv_max;
HvFILL(hv) = hv_fill;
- HvKEYS(hv) = HvKEYS(ohv);
+ HvTOTALKEYS(hv) = HvTOTALKEYS(ohv);
HvARRAY(hv) = ents;
}
else {
SvREFCNT_dec(val);
if (HeKLEN(entry) == HEf_SVKEY) {
SvREFCNT_dec(HeKEY_sv(entry));
- Safefree(HeKEY_hek(entry));
+ Safefree(HeKEY_hek(entry));
}
else if (HvSHAREKEYS(hv))
unshare_hek(HeKEY_hek(entry));
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) */,
(xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
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))
mg_clear((SV*)hv);
xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
xhv->xhv_eiter = Null(HE*); /* HvEITER(hv) = Null(HE*) */
/* used to be xhv->xhv_fill before 5.004_65 */
- return xhv->xhv_keys; /* HvKEYS(hv) */
+ return XHvTOTALKEYS(xhv);
}
/*
HeKLEN(entry) = HEf_SVKEY;
}
magic_nextpack((SV*) hv,mg,key);
- if (SvOK(key)) {
+ if (SvOK(key)) {
/* force key to stay around until next time */
HeSVKEY_set(entry, SvREFCNT_inc(key));
return entry; /* beware, hent_val is not set */
- }
+ }
if (HeVAL(entry))
SvREFCNT_dec(HeVAL(entry));
Safefree(HeKEY_hek(entry));
PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
char);
if (entry)
+ {
entry = HeNEXT(entry);
+ /*
+ * Skip past any placeholders -- don't want to include them in
+ * any iteration.
+ */
+ while (entry && HeVAL(entry) == &PL_sv_undef) {
+ entry = HeNEXT(entry);
+ }
+ }
while (!entry) {
xhv->xhv_riter++; /* HvRITER(hv)++ */
if (xhv->xhv_riter > xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
}
/* entry = (HvARRAY(hv))[HvRITER(hv)]; */
entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+
+ /* if we have an entry, but it's a placeholder, don't count it */
+ if (entry && HeVAL(entry) == &PL_sv_undef)
+ entry = 0;
+
}
if (oldentry && HvLAZYDEL(hv)) { /* was deleted earlier? */
/* what follows is the moral equivalent of:
if (!(Svp = hv_fetch(PL_strtab, str, len, FALSE)))
- hv_store(PL_strtab, str, len, Nullsv, hash);
+ hv_store(PL_strtab, str, len, Nullsv, hash);
*/
xhv = (XPVHV*)SvANY(PL_strtab);
/* assert(xhv_array != 0) */
void
Perl_savestack_grow(pTHX)
{
- PL_savestack_max = GROW(PL_savestack_max) + 4;
+ PL_savestack_max = GROW(PL_savestack_max) + 4;
Renew(PL_savestack, PL_savestack_max, ANY);
}
while (PL_tmps_ix > myfloor) { /* clean up after last statement */
SV* sv = PL_tmps_stack[PL_tmps_ix];
PL_tmps_stack[PL_tmps_ix--] = Nullsv;
- if (sv) {
+ if (sv && sv != &PL_sv_undef) {
SvTEMP_off(sv);
SvREFCNT_dec(sv); /* note, can modify tmps_ix!!! */
}
mg->mg_obj = osv;
}
SvFLAGS(osv) |= (SvFLAGS(osv) &
- (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
PL_tainted = oldtainted;
}
SvMAGIC(sv) = SvMAGIC(osv);
Perl_save_alloc(pTHX_ I32 size, I32 pad)
{
register I32 start = pad + ((char*)&PL_savestack[PL_savestack_ix]
- - (char*)PL_savestack);
+ - (char*)PL_savestack);
register I32 elems = 1 + ((size + pad - 1) / sizeof(*PL_savestack));
/* SSCHECK may not be good enough */
while (PL_savestack_ix + elems + 2 > PL_savestack_max)
- savestack_grow();
+ savestack_grow();
PL_savestack_ix += elems;
SSPUSHINT(elems);
SvSETMAGIC(sv);
PL_localizing = 0;
break;
- case SAVEt_SV: /* scalar reference */
+ case SAVEt_SV: /* scalar reference */
value = (SV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
ptr = &GvSV(gv);
SvREFCNT_dec(gv);
goto restore_sv;
- case SAVEt_GENERIC_PVREF: /* generic pv */
+ case SAVEt_GENERIC_PVREF: /* generic pv */
str = (char*)SSPOPPTR;
ptr = SSPOPPTR;
if (*(char**)ptr != str) {
*(char**)ptr = str;
}
break;
- case SAVEt_GENERIC_SVREF: /* generic sv */
+ case SAVEt_GENERIC_SVREF: /* generic sv */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
sv = *(SV**)ptr;
SvREFCNT_dec(sv);
SvREFCNT_dec(value);
break;
- case SAVEt_SVREF: /* scalar reference */
+ case SAVEt_SVREF: /* scalar reference */
value = (SV*)SSPOPPTR;
ptr = SSPOPPTR;
restore_sv:
sv = *(SV**)ptr;
DEBUG_S(PerlIO_printf(Perl_debug_log,
"restore svref: %p %p:%s -> %p:%s\n",
- ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
+ ptr, sv, SvPEEK(sv), value, SvPEEK(value)));
if (SvTYPE(sv) >= SVt_PVMG && SvMAGIC(sv) &&
SvTYPE(sv) != SVt_PVGV)
{
SvTYPE(value) != SVt_PVGV)
{
SvFLAGS(value) |= (SvFLAGS(value) &
- (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
+ (SVp_NOK|SVp_POK)) >> PRIVSHIFT;
SvMAGICAL_off(value);
/* XXX this is a leak when we get here because the
* mg_get() in save_scalar_at() croaked */
SvMAGIC(value) = 0;
}
- SvREFCNT_dec(sv);
+ SvREFCNT_dec(sv);
*(SV**)ptr = value;
PL_localizing = 2;
SvSETMAGIC(value);
PL_localizing = 0;
SvREFCNT_dec(value);
- break;
- case SAVEt_AV: /* array reference */
+ break;
+ case SAVEt_AV: /* array reference */
av = (AV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
if (GvAV(gv)) {
SvMAGIC(goner) = 0;
SvREFCNT_dec(goner);
}
- GvAV(gv) = av;
+ GvAV(gv) = av;
if (SvMAGICAL(av)) {
PL_localizing = 2;
SvSETMAGIC((SV*)av);
PL_localizing = 0;
}
- break;
- case SAVEt_HV: /* hash reference */
+ break;
+ case SAVEt_HV: /* hash reference */
hv = (HV*)SSPOPPTR;
gv = (GV*)SSPOPPTR;
if (GvHV(gv)) {
SvMAGIC(goner) = 0;
SvREFCNT_dec(goner);
}
- GvHV(gv) = hv;
+ GvHV(gv) = hv;
if (SvMAGICAL(hv)) {
PL_localizing = 2;
SvSETMAGIC((SV*)hv);
PL_localizing = 0;
}
- break;
+ break;
case SAVEt_INT: /* int reference */
ptr = SSPOPPTR;
*(int*)ptr = (int)SSPOPINT;
case SAVEt_GP: /* scalar reference */
ptr = SSPOPPTR;
gv = (GV*)SSPOPPTR;
- if (SvPVX(gv) && SvLEN(gv) > 0) {
- Safefree(SvPVX(gv));
- }
- SvPVX(gv) = (char *)SSPOPPTR;
- SvCUR(gv) = (STRLEN)SSPOPIV;
- SvLEN(gv) = (STRLEN)SSPOPIV;
- gp_free(gv);
- GvGP(gv) = (GP*)ptr;
+ if (SvPVX(gv) && SvLEN(gv) > 0) {
+ Safefree(SvPVX(gv));
+ }
+ SvPVX(gv) = (char *)SSPOPPTR;
+ SvCUR(gv) = (STRLEN)SSPOPIV;
+ SvLEN(gv) = (STRLEN)SSPOPIV;
+ gp_free(gv);
+ GvGP(gv) = (GP*)ptr;
if (GvCVu(gv))
PL_sub_generation++; /* putting a method back into circulation */
SvREFCNT_dec(gv);
- break;
+ break;
case SAVEt_FREESV:
ptr = SSPOPPTR;
SvREFCNT_dec((SV*)ptr);
sv = *(SV**)ptr;
/* Can clear pad variable in place? */
if (SvREFCNT(sv) <= 1 && !SvOBJECT(sv)) {
+ /*
+ * if a my variable that was made readonly is going out of
+ * scope, we want to remove the readonlyness so that it can
+ * go out of scope quietly
+ * Disabled as I don't see need yet NI-S 2001/12/18
+ */
+ if (0 && SvPADMY(sv) && ! SvFAKE(sv))
+ SvREADONLY_off(sv);
+
if (SvTHINKFIRST(sv))
sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
if (SvMAGICAL(sv))
ptr = SSPOPPTR;
(void)hv_delete(hv, (char*)ptr, (U32)SSPOPINT, G_DISCARD);
SvREFCNT_dec(hv);
- Safefree(ptr);
+ Safefree(ptr);
break;
case SAVEt_DESTRUCTOR:
ptr = SSPOPPTR;
projects / p5sagit/p5-mst-13.2.git / commitdiff