develooper Front page | perl.perl5.porters | Postings from October 2001

[PATCH] core-only patch for clamp/readonly hashes

Thread Previous | Thread Next
From:
Jeffrey Friedl
Date:
October 30, 2001 13:22
Subject:
[PATCH] core-only patch for clamp/readonly hashes
Message ID:
200110301839.f9UId6C74073@ventrue.corp.yahoo.com

Tim Bunce <Tim.Bunce@pobox.com> wrote:
|> I'm not very happy about growing the size of the hv struct (and it
|> may have knock on effects in terms of bucket allocation in malloc).
|> 
|> Didn't we discuss this before and agree that xnv_nv might be available
|> for use?  Did you (could you) look into that?

Good catch, and it was easy to do.
In order to not do floating point, I put it in as a union:

   struct xpvhv {
       char *	xhv_array;	/* pointer to malloced string */
       STRLEN	xhv_fill;	/* how full xhv_array currently is */
       STRLEN	xhv_max;	/* subscript of last element of xhv_array */
       IV	xhv_realkeys;	/* elements in the array (excl placeholders) */
       union {
         NV	  _nv;	  /* numeric value, if any (unused) */
         IV       _keys;  /* elements in the array (incl placeholders) */
       } xhv_u;
          :
          :
          :

It builds find, and all tests are fine.
(except Devel/Peek, which has some stuff hardcoded that expects a value
of zero for NV, so its failing is not a problem.)

|> > -#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no)
|> > +#define SvIMMORTAL(sv) ((sv)==&PL_sv_undef || (sv)==&PL_sv_yes || (sv)==&PL_sv_no || (sv)==&PL_sv_undef)
|> 
|> Umm, PL_sv_undef twice? (Was sv_placehold?)

Oops, my bad. I'd gotten rid of sv_placehold, but apparently not quite as
thoroughly as I should have :-)

|> > +	if (HeVAL(entry) == &PL_sv_undef) {
|> > +	    /*
|> > +	     * We'll be using this same slot, so the number of allocated
|> > +	     * keys doesn't go up, but the number of user-visible keys does.
|> > +	     */
|> > +	    xhv->xhv_realkeys++; /* HvREALKEYS(hv)++ */
|> > +	} else {
|> > +	    if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
|> > +		Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
|> > +
|> > +	    SvREFCNT_dec(HeVAL(entry));
|> > +	}
|> 
|> Since PL_sv_undef is SvREADONLY and !SvMAGICAL you could move the
|>     (HeVAL(entry) == &PL_sv_undef)
|> test inside the
|>     (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
|> test and save a test from the common case.

Another good call.
There were three places this might have been done, but I could do it in
only two. Trying to do it in the third tripped up Storable, which does
the very anti-social:

   * In order to avoid creating new SvIVs to hold the tagnum we just
   * cast the tagnum to a SV pointer and store that in the hash.

(from ext/Storable/Storable.xs line 2798)

But, could still modify the others, so it's all the faster now.
It's a comment on just how light weight these changes are that removing one
integer compare provides for a significant relative savings :-)


|> > +	Perl_croak(aTHX_ "Can't delete key {%s} of readonly/clamped", key);
|> 
|> And don't forget perldiag.pod entries fro all these :)

Didn't forget --- just wanted to see things gel first. They have, so I've
included them this time.

Appended is the core-only patch to facilitate readonly and clamped hashes.
It's been tested with my sample XS and fairly large test suite.

     Jeffrey




--- bleedperl.orig/pod/perldiag.pod	Sat Sep 29 14:12:23 2001
+++ bleedperl/pod/perldiag.pod	Tue Oct 30 10:33:26 2001
@@ -449,6 +449,17 @@
 you have also specified an explicit size for the string.  See
 L<perlfunc/pack>.
 
+=item Can't access nonexistant key {%s} of readonly/clamped hash
+
+(F) You attempted to access a nonexistant key of a hash that has been marked
+readonly, or has had its set of keys clamped (frozen). You can always check
+if a key C<exists()>, but other kinds of access of such keys are errors.
+
+=item Can't add a new key {%s} to readonly/clamped hash
+
+(F) You attempted to add a new key to a hash that has been marked
+readonly, or has had its set of keys clamped (frozen).
+
 =item Can't bless non-reference value
 
 (F) Only hard references may be blessed.  This is how Perl "enforces"
@@ -545,6 +556,11 @@
 (F) Only scalar, array, and hash variables may be declared as "my" or
 "our" variables.  They must have ordinary identifiers as names.
 
+=item Can't delete key {%s} of readonly/clamped
+
+(F) You attempted to delete a key from a hash that has been marked
+readonly, or has had its set of keys clamped (frozen).
+
 =item Can't do inplace edit: %s is not a regular file
 
 (S inplace) You tried to use the B<-i> switch on a special file, such as
@@ -821,6 +837,12 @@
 
 (F) Subroutines meant to be used in lvalue context should be declared as
 such, see L<perlsub/"Lvalue subroutines">.
+
+=item Can't modify readonly value for key {%s}
+
+You attempted to modify a value in a readonly hash, or to modify a value
+(associated with a particular key) that had been previously marked
+readonly.
 
 =item Can't msgrcv to read-only var
 
--- bleedperl.orig/hv.h	Sun Jun 17 19:01:05 2001
+++ bleedperl/hv.h	Tue Oct 30 08:42:25 2001
@@ -31,8 +31,12 @@
     char *	xhv_array;	/* pointer to malloced string */
     STRLEN	xhv_fill;	/* how full xhv_array currently is */
     STRLEN	xhv_max;	/* subscript of last element of xhv_array */
-    IV		xhv_keys;	/* how many elements in the array */
-    NV		xnv_nv;		/* numeric value, if any */
+    IV		xhv_realkeys;	/* elements in the array (excl placeholders) */
+    union {
+      NV		_nv;	/* numeric value, if any (unused)*/
+      IV                _keys;  /* elements in the array (incl placeholders) */
+    } xhv_u;
+#define xhv_keys xhv_u._keys
     MAGIC*	xmg_magic;	/* magic for scalar array */
     HV*		xmg_stash;	/* class package */
 
@@ -127,10 +131,15 @@
 #define HvFILL(hv)	((XPVHV*)  SvANY(hv))->xhv_fill
 #define HvMAX(hv)	((XPVHV*)  SvANY(hv))->xhv_max
 #define HvKEYS(hv)	((XPVHV*)  SvANY(hv))->xhv_keys
+#define HvREALKEYS(hv)	((XPVHV*)  SvANY(hv))->xhv_realkeys
 #define HvRITER(hv)	((XPVHV*)  SvANY(hv))->xhv_riter
 #define HvEITER(hv)	((XPVHV*)  SvANY(hv))->xhv_eiter
 #define HvPMROOT(hv)	((XPVHV*)  SvANY(hv))->xhv_pmroot
 #define HvNAME(hv)	((XPVHV*)  SvANY(hv))->xhv_name
+
+#define HvCLAMPEDACCESS(hv)	(SvFLAGS(hv) &   SVh_CLAMP_ACCESS)
+#define HvCLAMPEDACCESS_on(hv)	(SvFLAGS(hv) |=  SVh_CLAMP_ACCESS)
+#define HvCLAMPEDACCESS_off(hv)	(SvFLAGS(hv) &= ~SVh_CLAMP_ACCESS)
 
 #define HvSHAREKEYS(hv)		(SvFLAGS(hv) & SVphv_SHAREKEYS)
 #define HvSHAREKEYS_on(hv)	(SvFLAGS(hv) |= SVphv_SHAREKEYS)
--- bleedperl.orig/sv.h	Sat Oct 27 19:37:31 2001
+++ bleedperl/sv.h	Tue Oct 30 08:38:46 2001
@@ -234,6 +234,8 @@
 
 #define SVprv_WEAKREF   0x80000000      /* Weak reference */
 
+#define SVh_CLAMP_ACCESS 0x08000000	/* hash access has been clamped */
+
 struct xrv {
     SV *	xrv_rv;		/* pointer to another SV */
 };
--- bleedperl.orig/hv.c	Tue Oct 16 13:44:11 2001
+++ bleedperl/hv.c	Tue Oct 30 10:03:37 2001
@@ -222,6 +222,14 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
+
+	/* if we find the entry but it's a placeholder, it's as if not found */
+	if (HeVAL(entry) == &PL_sv_undef)
+	    break;
+
+	if (lval && SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+	    Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
+
 	return &HeVAL(entry);
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -237,6 +245,29 @@
 	}
     }
 #endif
+
+    /*
+     * If we get here and lval is true, we're trying to add a new key.
+     */
+    if (lval)
+    {
+	if (SvREADONLY(hv))
+	    Perl_croak(aTHX_ "Can't add a new key {%s} to readonly/clamped hash", key);
+	/* if not readonly, allowed to add a new key even if clamped */
+    }
+    else if (!entry && HvCLAMPEDACCESS(hv))
+    {
+	/*
+	 * If we get here, we're trying to access (not add) a new key.
+	 * If entry has something, it's because we bailed above due to
+	 * &PL_sv_undef, and in that case it's a "pre-approved" key
+	 * that we can access. But if not and we get here, it's an attempt
+	 * to access a brand new key, and that's not allowed if clamped.
+	 */
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly/clamped hash", key);
+    }
+
+
     if (lval) {		/* gonna assign to this, so it better be there */
 	sv = NEWSV(61,0);
 	if (key != keysave) { /* must be is_utf8 == 0 */
@@ -282,6 +313,7 @@
     bool is_utf8;
     char *keysave;
 
+
     if (!hv)
 	return 0;
 
@@ -352,6 +384,28 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
+
+
+	/* if we find the entry but it's a placeholder, it's as if not found */
+	if (HeVAL(entry) == &PL_sv_undef)
+	    break;
+
+#if 0
+	/*
+	 * I want to have this here so that access to a readonly key gives
+	 * a message that tells which key is being accessed, but since it
+	 * seems that the when executing
+	 *     \$hash{KEY}
+	 * this function is called to get the reference, but its done with
+	 * a true 'lval', so it makes it appear that it's an assignment.
+	 * (Probably because the key must autovivify)
+	 *
+	 * Bummer.
+	 */
+	if (lval && SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+	    Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
+#endif
+
 	return entry;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* %ENV lookup?  If so, try to fetch the value now */
@@ -365,6 +419,28 @@
 	}
     }
 #endif
+
+    /*
+     * If we get here and lval is true, we're trying to add a new key.
+     */
+    if (lval)
+    {
+	if (SvREADONLY(hv))
+	    Perl_croak(aTHX_ "Can't add a new key {%s} to readonly/clamped hash", key);
+	/* if not readonly, allowed to add a new key even if clamped */
+    }
+    else if (!entry && HvCLAMPEDACCESS(hv))
+    {
+	/*
+	 * If we get here, we're trying to access (not add) a new key.
+	 * If entry has something, it's because we bailed above due to
+	 * &PL_sv_undef, and in that case it's a "pre-approved" key
+	 * that we can access. But if not and we get here, it's an attempt
+	 * to access a brand new key, and that's not allowed if clamped.
+	 */
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly/clamped hash", key);
+    }
+
     if (key != keysave)
 	Safefree(key);
     if (lval) {		/* gonna assign to this, so it better be there */
@@ -475,13 +551,35 @@
 	    continue;
 	if (HeKUTF8(entry) != (char)is_utf8)
 	    continue;
-	SvREFCNT_dec(HeVAL(entry));
+
+        if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+        {
+            /* Of we get here, we have either a placeholder (PL_sv_undef),
+             * or a readonly value. */
+
+            if (HeVAL(entry) == &PL_sv_undef) {
+                /*
+                 * We'll be using this same slot, so the number of
+                 * allocated keys doesn't go up, but the number of
+                 * user-visible keys does.
+                 */
+                xhv->xhv_realkeys++; /* HvREALKEYS(hv)++ */
+            } else {
+		Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
+            }
+        } else {
+	    SvREFCNT_dec(HeVAL(entry));
+	}
+
 	HeVAL(entry) = val;
 	if (key != keysave)
 	    Safefree(key);
 	return &HeVAL(entry);
     }
 
+    if (!val && HvCLAMPEDACCESS(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly/clamped hash", key);
+
     entry = new_HE();
     if (HvSHAREKEYS(hv))
 	HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
@@ -489,11 +587,13 @@
 	HeKEY_hek(entry) = save_hek(key, is_utf8?-klen:klen, hash);
     if (key != keysave)
 	Safefree(key);
+
     HeVAL(entry) = val;
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
+    xhv->xhv_realkeys++; /* HvREALKEYS(hv)-- */
     if (i) {				/* initial entry? */
 	xhv->xhv_fill++; /* HvFILL(hv)++ */
 	if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
@@ -563,6 +663,7 @@
     }
 
     keysave = key = SvPV(keysv, klen);
+
     is_utf8 = (SvUTF8(keysv) != 0);
 
     if (is_utf8)
@@ -589,13 +690,50 @@
 	    continue;
 	if (HeKUTF8(entry) != (char)is_utf8)
 	    continue;
-	SvREFCNT_dec(HeVAL(entry));
+
+        if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+        {
+            /* Of we get here, we have either a placeholder (PL_sv_undef),
+             * or a readonly value. */
+
+            if (HeVAL(entry) == &PL_sv_undef) {
+                /*
+                 * We'll be using this same slot, so the number of
+                 * allocated keys doesn't go up, but the number of
+                 * user-visible keys does.
+                 */
+                xhv->xhv_realkeys++; /* HvREALKEYS(hv)++ */
+            } else {
+		Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
+            }
+        } else {
+	    SvREFCNT_dec(HeVAL(entry));
+	}
+
+#if 0
+	if (HeVAL(entry) == &PL_sv_undef) {
+	    /*
+	     * We'll be using this same slot, so the number of allocated
+	     * keys doesn't go up, but the number of user-visible keys does.
+	     */
+	    xhv->xhv_realkeys++; /* HvREALKEYS(hv)++ */
+	} else {
+	    if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+		Perl_croak(aTHX_ "Can't modify readonly value for key {%s}", key);
+
+	    SvREFCNT_dec(HeVAL(entry));
+	}
+#endif
+
 	HeVAL(entry) = val;
 	if (key != keysave)
 	    Safefree(key);
 	return entry;
     }
 
+    if (!val && HvCLAMPEDACCESS(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of readonly/clamped hash", key);
+
     entry = new_HE();
     if (HvSHAREKEYS(hv))
 	HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
@@ -608,6 +746,7 @@
     *oentry = entry;
 
     xhv->xhv_keys++; /* HvKEYS(hv)++ */
+    xhv->xhv_realkeys++; /* HvREALKEYS(hv)-- */
     if (i) {				/* initial entry? */
 	xhv->xhv_fill++; /* HvFILL(hv)++ */
 	if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
@@ -675,6 +814,9 @@
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
 	return Nullsv;
 
+    if (SvREADONLY(hv))
+	Perl_croak(aTHX_ "Can't delete key {%s} of readonly/clamped", key);
+
     if (is_utf8) {
 	STRLEN tmplen = klen;
 	/* See the note in hv_fetch(). --jhi */
@@ -699,20 +841,40 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	*oentry = HeNEXT(entry);
+
+	/* found the key to delete */
+	if (!HvCLAMPEDACCESS(hv))
+	    *oentry = HeNEXT(entry);
+
 	if (i && !*oentry)
 	    xhv->xhv_fill--; /* HvFILL(hv)-- */
 	if (flags & G_DISCARD)
 	    sv = Nullsv;
 	else {
 	    sv = sv_2mortal(HeVAL(entry));
+	    if (!HvCLAMPEDACCESS(hv))
+		HeVAL(entry) = &PL_sv_undef;
+	}
+
+	/*
+	 * If access is clamped, 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 (HvCLAMPEDACCESS(hv)) {
 	    HeVAL(entry) = &PL_sv_undef;
+	    /* We'll be saving this same slot, so the number of allocated keys
+	     * doesn't go down, but the number of user-visible keys does. */
+	    xhv->xhv_realkeys--; /* HvREALKEYS(hv)-- */
+	} else {
+	    if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+		HvLAZYDEL_on(hv);
+	    else
+		hv_free_ent(hv, entry);
+	    xhv->xhv_keys--; /* HvKEYS(hv)-- */
+	    xhv->xhv_realkeys--; /* HvREALKEYS(hv)-- */
 	}
-	if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-	    HvLAZYDEL_on(hv);
-	else
-	    hv_free_ent(hv, entry);
-	xhv->xhv_keys--; /* HvKEYS(hv)-- */
 	return sv;
     }
     if (key != keysave)
@@ -744,6 +906,7 @@
     bool is_utf8;
     char *keysave;
 
+
     if (!hv)
 	return Nullsv;
     if (SvRMAGICAL(hv)) {
@@ -779,6 +942,9 @@
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
+    if (SvREADONLY(hv))
+	Perl_croak(aTHX_ "Can't delete key {%s} of readonly/clamped", key);
+
     if (is_utf8)
 	key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
@@ -800,20 +966,40 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	*oentry = HeNEXT(entry);
+
+	/* found the key to delete */
+	if (!HvCLAMPEDACCESS(hv))
+	    *oentry = HeNEXT(entry);
+
 	if (i && !*oentry)
 	    xhv->xhv_fill--; /* HvFILL(hv)-- */
-	if (flags & G_DISCARD)
+	if (flags & G_DISCARD) {
 	    sv = Nullsv;
-	else {
+	} else {
 	    sv = sv_2mortal(HeVAL(entry));
+	    if (!HvCLAMPEDACCESS(hv))
+		HeVAL(entry) = &PL_sv_undef;
+	}
+
+	/*
+	 * If access is clamped, 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 (HvCLAMPEDACCESS(hv)) {
 	    HeVAL(entry) = &PL_sv_undef;
+	    /* We'll be saving this same slot, so the number of allocated keys
+	     * doesn't go down, but the number of user-visible keys does. */
+	    xhv->xhv_realkeys--; /* HvREALKEYS(hv)-- */
+	} else {
+	    if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
+		HvLAZYDEL_on(hv);
+	    else
+		hv_free_ent(hv, entry);
+	    xhv->xhv_keys--; /* HvKEYS(hv)-- */
+	    xhv->xhv_realkeys--; /* HvREALKEYS(hv)-- */
 	}
-	if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-	    HvLAZYDEL_on(hv);
-	else
-	    hv_free_ent(hv, entry);
-	xhv->xhv_keys--; /* HvKEYS(hv)-- */
 	return sv;
     }
     if (key != keysave)
@@ -895,7 +1081,16 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	return TRUE;
+
+	/*
+	 * If we find the key, but the value is a placeholder, we return
+	 * false (but leave the placeholder so we can access the key even
+	 * with access clamped).
+	 */
+	if (HeVAL(entry) == &PL_sv_undef)
+	    return FALSE;
+	else
+	    return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -988,7 +1183,15 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	return TRUE;
+	/*
+	 * If we find the key, but the value is a placeholder, we return
+	 * false (but leave the placeholder so we can access the key even
+	 * with access clamped).
+	 */
+	if (HeVAL(entry) == &PL_sv_undef)
+	    return FALSE;
+	else
+	    return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -1308,8 +1511,9 @@
 	return;
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
-    xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
-    xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
+    xhv->xhv_fill = 0;     /* HvFILL(hv) = 0 */
+    xhv->xhv_keys = 0;     /* HvKEYS(hv) = 0 */
+    xhv->xhv_realkeys = 0; /* HvREALKEYS(hv) = 0 */
     if (xhv->xhv_array /* HvARRAY(hv) */)
 	(void)memzero(xhv->xhv_array /* HvARRAY(hv) */,
 		      (xhv->xhv_max+1 /* HvMAX(hv)+1 */) * sizeof(HE*));
@@ -1376,6 +1580,7 @@
     xhv->xhv_array = 0;	/* HvARRAY(hv) = 0 */
     xhv->xhv_fill  = 0;	/* HvFILL(hv) = 0 */
     xhv->xhv_keys  = 0;	/* HvKEYS(hv) = 0 */
+    xhv->xhv_realkeys  = 0; /* HvREALKEYS(hv) = 0 */
 
     if (SvRMAGICAL(hv))
 	mg_clear((SV*)hv);
@@ -1385,7 +1590,7 @@
 =for apidoc hv_iterinit
 
 Prepares a starting point to traverse a hash table.  Returns the number of
-keys in the hash (i.e. the same as C<HvKEYS(tb)>).  The return value is
+keys in the hash (i.e. the same as C<HvREALKEYS(tb)>).  The return value is
 currently only meaningful for hashes without tie magic.
 
 NOTE: Before version 5.004_65, C<hv_iterinit> used to return the number of
@@ -1412,7 +1617,7 @@
     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 xhv->xhv_realkeys; /* HvREALKEYS(hv) */
 }
 
 /*
@@ -1476,8 +1681,19 @@
 	Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
 	     PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
 	     char);
-    if (entry)
+    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) */) {
@@ -1486,6 +1702,10 @@
 	}
 	/* entry = (HvARRAY(hv))[HvRITER(hv)]; */
 	entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
+
+	/* if we have an entry, but it's a placeholder, we don't have squat */
+	while (entry && HeVAL(entry) == &PL_sv_undef)
+	    entry = 0;
     }
 
     if (oldentry && HvLAZYDEL(hv)) {		/* was deleted earlier? */
@@ -1654,6 +1874,7 @@
 	    Safefree(HeKEY_hek(entry));
 	    del_HE(entry);
 	    xhv->xhv_keys--; /* HvKEYS(hv)-- */
+	    xhv->xhv_realkeys--; /* HvREALKEYS(hv)-- */
 	}
 	break;
     }
@@ -1716,6 +1937,7 @@
 	HeNEXT(entry) = *oentry;
 	*oentry = entry;
 	xhv->xhv_keys++; /* HvKEYS(hv)++ */
+	xhv->xhv_realkeys++; /* HvREALKEYS(hv)++ */
 	if (i) {				/* initial entry? */
 	    xhv->xhv_fill++; /* HvFILL(hv)++ */
 	    if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
--- bleedperl.orig/doop.c	Mon Sep  3 09:18:09 2001
+++ bleedperl/doop.c	Mon Oct 29 22:00:47 2001
@@ -1303,7 +1303,7 @@
 	}
 
 	if (! SvTIED_mg((SV*)keys, PERL_MAGIC_tied))
-	    i = HvKEYS(keys);
+	    i = HvREALKEYS(keys);
 	else {
 	    i = 0;
 	    /*SUPPRESS 560*/
@@ -1313,7 +1313,7 @@
 	RETURN;
     }
 
-    EXTEND(SP, HvKEYS(keys) * (dokeys + dovalues));
+    EXTEND(SP, HvREALKEYS(keys) * (dokeys + dovalues));
 
     PUTBACK;	/* hv_iternext and hv_iterval might clobber stack_sp */
     while ((entry = hv_iternext(keys))) {
--- bleedperl.orig/scope.c	Fri Oct 26 07:09:53 2001
+++ bleedperl/scope.c	Mon Oct 29 22:05:44 2001
@@ -169,7 +169,7 @@
     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!!! */
 	}
@@ -823,8 +823,18 @@
 	    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
+		 */
+		if (SvPADMY(sv))
+		    SvREADONLY_off(sv);
+
 		if (SvTHINKFIRST(sv))
+		{
 		    sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
+		}
 		if (SvMAGICAL(sv))
 		    mg_free(sv);
 
--- bleedperl.orig/mg.c	Sun Oct 28 15:59:51 2001
+++ bleedperl/mg.c	Mon Oct 29 22:00:47 2001
@@ -1162,7 +1162,7 @@
     if (hv) {
          (void) hv_iterinit(hv);
          if (! SvTIED_mg((SV*)hv, PERL_MAGIC_tied))
-	     i = HvKEYS(hv);
+	     i = HvREALKEYS(hv);
          else {
 	     while (hv_iternext(hv))
 	         i++;
--- bleedperl.orig/sv.c	Sun Oct 28 15:59:51 2001
+++ bleedperl/sv.c	Mon Oct 29 22:00:47 2001
@@ -1418,6 +1418,7 @@
 	HvFILL(sv)	= 0;
 	HvMAX(sv)	= 0;
 	HvKEYS(sv)	= 0;
+	HvREALKEYS(sv)	= 0;
 	SvNVX(sv)	= 0.0;
 	SvMAGIC(sv)	= magic;
 	SvSTASH(sv)	= stash;
--- bleedperl.orig/ext/Devel/Peek/Peek.t	Thu Sep 27 16:25:56 2001
+++ bleedperl/ext/Devel/Peek/Peek.t	Tue Oct 30 10:11:34 2001
@@ -27,6 +27,7 @@
 	if (open(IN, "peek$$")) {
 	    local $/;
 	    $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
+	    $pattern =~ s/\$FLOAT/\\d+\\.\\d+(?:e[-+]\\d+)?/g;
 	    print $pattern, "\n" if $DEBUG;
 	    my $dump = <IN>;
 	    print $dump, "\n"    if $DEBUG;
@@ -187,7 +188,7 @@
     REFCNT = 2
     FLAGS = \\(SHAREKEYS\\)
     IV = 1
-    NV = 0
+    NV = $FLOAT
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
     KEYS = 1
@@ -336,7 +337,7 @@
     REFCNT = 2
     FLAGS = \\(SHAREKEYS\\)
     IV = 1
-    NV = 0
+    NV = $FLOAT
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
     KEYS = 1
--- bleedperl.orig/t/lib/1_compile.t	Mon Oct 29 06:55:52 2001
+++ bleedperl/t/lib/1_compile.t	Mon Oct 29 22:46:47 2001
@@ -182,6 +182,7 @@
 Pod::Find
 Pod::Text
 Pod::Usage
+Readonly
 SDBM_File
 Safe
 Scalar::Util

Thread Previous | Thread Next


nntp.perl.org: Perl Programming lists via nntp and http.
Comments to Ask Bjørn Hansen at ask@perl.org | Group listing | About