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

restricted hashes, and other readonlyness (was "clamp...")

Thread Previous | Thread Next
From:
Jeffrey Friedl
Date:
November 1, 2001 01:18
Subject:
restricted hashes, and other readonlyness (was "clamp...")
Message ID:
200111010917.fA19HXX18300@ventrue.corp.yahoo.com

Okay, I got rid of the union, the 'realkeys' stuff, added what was
needed for array readonlyness, and generally tidied up.

I've dropped the "clamp" nomenclature, in favor of "pseudo-enumerated" or
"restricted" hashes.  (I still don't care what we call it, but I've got
to use something....)


So, here's the current status after the appended patch:

 SCALARS
 -------
   Readonlyness can be set and cleared.
   (as before -- no changes with ths patch)

 ARRAYS
 ------
   Readonlyness can be set and cleared.
   An array that is SvREADONLY prohibits anything that would
   change the size of the array, and the deletion of elements.
 
 HASHES
 ------
   Two new bits: SvREADONLY and HvPSEUDO_ENUMERATED

   A hash that is SvREADONLY (but not HvPSEUDO_ENUMERATED) has a readonly
   set of keys: no adding new keys or deleting existing keys.

   A hash that is SvREADONLY and HvPSEUDO_ENUMERATED is a "restricted hash"
   or a "pseudo-enumerated hash".  This means that the hash has a set of
   "approved" keys, and all operations are allowed with those keys.
   Any access, other than exists(), with a key that is not approved results
   in an error.

   A hash that is HvPSEUDO_ENUMERATED (and not SvREADONLY) may add and delete
   keys freely, but read access of a non-existant key is an error. This is
   a less restrictive form of a pseudo-enumerated hash that says "you can
   add elements freely, but if you're going to try to read an element, it
   had better actually be there."

   exists() now returns:
       1      -- is there
       ''     -- not there, and not allowed.
       undef  -- not there, but could be. (Doesn't exist, but is "allowed")
   Previously, it returned only 1 and ''.
   

   keys(), values(), and each() return data only for keys that actually
   exist(). They ignore, for example, keys that are "approved" but don't
   yet exist. In a scalar context, it returns the number of keys that
   actually exist.  (It's left to an XS module to provide a way to get
   the full list of approved keys.)

   For *any* hash, if...

        my @K     = keys %HASH;
        my @V     = values %HASH;
        my $count = 0;
        while (my ($key,$val) = each %HASH) {
           $count++;
        }

   then these are always true:

      keys(%HASH) == @K;
      keys(%HASH) == @V;
      keys(%HASH) == $count;
  

There are (at least) two issues that remain:

* Doesn't use the value for the SVh_PSEUDO_ENUMERATED flag that Nick wanted.
  Easy to update when he says what value to use.

* Arrays -- I implemented the semantics that people asked for (lock the
  size of the array), but I see a problem in that there's no way to have a
  totally readonly array. With hashes, if you want a totally readonly hash,
  you merely set SvREADONLY on the hash, and on each of its values. But
  with an array, if you do that, you can still put values to empty slots in
  a sparce array:
       my @a = (1,2,3);
       $a[100] = 'big';
       magically_make_totally_readonly @a;
       $a[50] = 'half';       <-- should not be allowed, but currently is
  
  Would it make sense to also disallow the creation of embedded elements
  that don't currently exist()?


Current patch follows,
    Jeffrey

-------------------------------------------------



--- bleedperl.orig/pod/perldiag.pod	Sat Sep 29 14:12:23 2001
+++ bleedperl/pod/perldiag.pod	Wed Oct 31 22:52:34 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 restricted hash
+
+(F) You attempted to access a nonexistant and non-approved key of a hash
+that has been marked as a pseudo-enumerated hash. (You can, however, always
+check if a key C<exists()>.)
+
+=item Can't add a new key {%s} to readonly hash
+
+(F) You attempted to add a new key to a hash that has been marked
+readonly.
+
 =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 hash
+
+(F) You attempted to delete a key from a hash that has been marked
+readonly.
+
 =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/pp.c	Fri Oct 26 15:26:05 2001
+++ bleedperl/pp.c	Thu Nov  1 00:03:09 2001
@@ -3588,6 +3588,8 @@
     if (SvTYPE(hv) == SVt_PVHV) {
 	if (hv_exists_ent(hv, tmpsv, 0))
 	    RETPUSHYES;
+        else if (PL_recent_nonexists_is_allowed)
+            RETPUSHUNDEF;
     }
     else if (SvTYPE(hv) == SVt_PVAV) {
 	if (PL_op->op_flags & OPf_SPECIAL) {		/* array element */
@@ -3817,6 +3819,10 @@
 
     newlen = SP - MARK;
     diff = newlen - length;
+
+    if (diff && SvREADONLY(ary))
+        Perl_croak(aTHX_ PL_no_modify);
+
     if (newlen && !AvREAL(ary) && AvREIFY(ary))
 	av_reify(ary);
 
--- bleedperl.orig/hv.h	Sun Jun 17 19:01:05 2001
+++ bleedperl/hv.h	Wed Oct 31 22:55:43 2001
@@ -31,8 +31,9 @@
     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_keys;	/* elements in the hash (incl placeholders) */
+    NV          xnv_nv;         /* count of placeholders */
+#define xhv_placeholders xnv_nv
     MAGIC*	xmg_magic;	/* magic for scalar array */
     HV*		xmg_stash;	/* class package */
 
@@ -122,11 +123,34 @@
 #define HEf_SVKEY	-2	/* hent_key is a SV* */
 
 
+/* the number of keys (including any placeholers) */
+#define XHvTOTALKEYS(xhv)     ((xhv)->xhv_keys)
+
+/* The number of placeholders in the enumerated-keys hash */
+#define XHvPLACEHOLDERS(xhv)  ((xhv)->xhv_placeholders)
+
+/* the number of keys that exist() (i.e. excluding placeholers) */
+#define XHvUSEDKEYS(xhv)      (XHvTOTALKEYS(xhv) - XHvPLACEHOLDERS(xhv))
+
+#define HvPSEUDO_ENUMERATED(hv)	    (SvFLAGS(hv) &   SVh_PSEUDO_ENUMERATED)
+#define HvPSEUDO_ENUMERATED_on(hv)   (SvFLAGS(hv) |=  SVh_PSEUDO_ENUMERATED)
+#define HvPSEUDO_ENUMERATED_off(hv)  (SvFLAGS(hv) &= ~SVh_PSEUDO_ENUMERATED)
+
+
+/*
+ * HvKEYS gets the number of keys that actually exist(), and is provided
+ * for backwards compatibility with old XS code. The core uses HvUSEDKEYS
+ * (keys, excluding placeholdes) and HvTOTALKEYS (including placeholders)
+ */
+#define HvKEYS(hv)	   XHvUSEDKEYS((XPVHV*)  SvANY(hv))
+#define HvUSEDKEYS(hv)	   XHvUSEDKEYS((XPVHV*)  SvANY(hv))
+#define HvTOTALKEYS(hv)    XHvTOTALKEYS((XPVHV*)  SvANY(hv))
+#define HvPLACEHOLDERS(hv) XHvPLACEHOLDERS((XPVHV*)  SvANY(hv))
+
 #define Nullhv Null(HV*)
 #define HvARRAY(hv)	(*(HE***)&((XPVHV*)  SvANY(hv))->xhv_array)
 #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 HvRITER(hv)	((XPVHV*)  SvANY(hv))->xhv_riter
 #define HvEITER(hv)	((XPVHV*)  SvANY(hv))->xhv_eiter
 #define HvPMROOT(hv)	((XPVHV*)  SvANY(hv))->xhv_pmroot
--- bleedperl.orig/sv.h	Sat Oct 27 19:37:31 2001
+++ bleedperl/sv.h	Wed Oct 31 21:50:21 2001
@@ -234,6 +234,8 @@
 
 #define SVprv_WEAKREF   0x80000000      /* Weak reference */
 
+#define SVh_PSEUDO_ENUMERATED  0x08000000  /* hash is in a pseudo-enumerated hash state*/
+
 struct xrv {
     SV *	xrv_rv;		/* pointer to another SV */
 };
--- bleedperl.orig/hv.c	Tue Oct 16 13:44:11 2001
+++ bleedperl/hv.c	Thu Nov  1 01:13:48 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 hash", key);
+	/* if not readonly, allowed to add a new key even if restricted */
+    }
+    else if (!entry && HvPSEUDO_ENUMERATED(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 restricted
+	 */
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted 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 */
@@ -352,6 +383,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 +418,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 hash", key);
+	/* if not readonly, allowed to add a new key even if restricted */
+    }
+    else if (!entry && HvPSEUDO_ENUMERATED(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 restricted.
+	 */
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted hash", key);
+    }
+
     if (key != keysave)
 	Safefree(key);
     if (lval) {		/* gonna assign to this, so it better be there */
@@ -475,13 +550,35 @@
 	    continue;
 	if (HeKUTF8(entry) != (char)is_utf8)
 	    continue;
-	SvREFCNT_dec(HeVAL(entry));
+
+        if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+        {
+            /* If we get here, we have either a placeholder (PL_sv_undef),
+             * or a readonly value. If we're still pseudo-enumerated, it's
+             * okay to reuse a placeholder, but if we're no longer pseudo-
+             * enumerated, we can't use the left-over placeholder */
+            if (HeVAL(entry) == &PL_sv_undef && HvPSEUDO_ENUMERATED(hv)) {
+                /*
+                 * We'll reuse this slot, so the number of allocated keys
+                 * doesn't go up, but the number of placeholders goes down.
+                 */
+                xhv->xhv_placeholders--; /* HvPLACEHOLDERS(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 && HvPSEUDO_ENUMERATED(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted hash", key);
+
     entry = new_HE();
     if (HvSHAREKEYS(hv))
 	HeKEY_hek(entry) = share_hek(key, is_utf8?-klen:klen, hash);
@@ -493,7 +590,7 @@
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
-    xhv->xhv_keys++; /* HvKEYS(hv)++ */
+    xhv->xhv_keys++;
     if (i) {				/* initial entry? */
 	xhv->xhv_fill++; /* HvFILL(hv)++ */
 	if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
@@ -589,13 +686,35 @@
 	    continue;
 	if (HeKUTF8(entry) != (char)is_utf8)
 	    continue;
-	SvREFCNT_dec(HeVAL(entry));
+
+        if (SvREADONLY(HeVAL(entry)) && !SvMAGICAL(HeVAL(entry)))
+        {
+            /* If we get here, we have either a placeholder (PL_sv_undef),
+             * or a readonly value. If we're still pseudo-enumerated, it's
+             * okay to reuse a placeholder, but if we're no longer pseudo-
+             * enumerated, we can't use the left-over placeholder */
+            if (HeVAL(entry) == &PL_sv_undef && HvPSEUDO_ENUMERATED(hv)) {
+                /*
+                 * We'll reuse this slot, so the number of allocated keys
+                 * doesn't go up, but the number of placeholders goes down.
+                 */
+                xhv->xhv_placeholders--; /* HvPLACEHOLDERS(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 entry;
     }
 
+    if (!val && HvPSEUDO_ENUMERATED(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted hash", key);
+
     entry = new_HE();
     if (HvSHAREKEYS(hv))
 	HeKEY_hek(entry) = share_hek(key, is_utf8?-(I32)klen:klen, hash);
@@ -607,7 +726,7 @@
     HeNEXT(entry) = *oentry;
     *oentry = entry;
 
-    xhv->xhv_keys++; /* HvKEYS(hv)++ */
+    xhv->xhv_keys++;
     if (i) {				/* initial entry? */
 	xhv->xhv_fill++; /* HvFILL(hv)++ */
 	if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
@@ -699,22 +818,46 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	*oentry = HeNEXT(entry);
+
+	/* found the key to delete */
+	if (!HvPSEUDO_ENUMERATED(hv)) {
+            if (SvREADONLY(hv))
+                Perl_croak(aTHX_ "Can't delete key {%s} of readonly hash", key);
+	    *oentry = HeNEXT(entry);
+        }
+
 	if (i && !*oentry)
 	    xhv->xhv_fill--; /* HvFILL(hv)-- */
 	if (flags & G_DISCARD)
 	    sv = Nullsv;
 	else {
 	    sv = sv_2mortal(HeVAL(entry));
+	    if (!HvPSEUDO_ENUMERATED(hv))
+		HeVAL(entry) = &PL_sv_undef;
+	}
+
+	/*
+	 * If it's a pseudo-enumerated 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 (HvPSEUDO_ENUMERATED(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--;
 	}
-	if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-	    HvLAZYDEL_on(hv);
-	else
-	    hv_free_ent(hv, entry);
-	xhv->xhv_keys--; /* HvKEYS(hv)-- */
 	return sv;
     }
+    if (HvPSEUDO_ENUMERATED(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted hash", key);
     if (key != keysave)
 	Safefree(key);
     return Nullsv;
@@ -779,6 +922,9 @@
     keysave = key = SvPV(keysv, klen);
     is_utf8 = (SvUTF8(keysv) != 0);
 
+    if (SvREADONLY(hv))
+	Perl_croak(aTHX_ "Can't delete key {%s} of readonly hash", key);
+
     if (is_utf8)
 	key = (char*)bytes_from_utf8((U8*)key, &klen, &is_utf8);
 
@@ -800,22 +946,47 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	*oentry = HeNEXT(entry);
+
+	/* found the key to delete */
+	if (!HvPSEUDO_ENUMERATED(hv)) {
+            if (SvREADONLY(hv))
+                Perl_croak(aTHX_ "Can't delete key {%s} of readonly hash", key);
+	    *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 (!HvPSEUDO_ENUMERATED(hv))
+		HeVAL(entry) = &PL_sv_undef;
+	}
+
+	/*
+	 * If a pseudo-enumerated 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 (HvPSEUDO_ENUMERATED(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 of 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--;
 	}
-	if (entry == xhv->xhv_eiter /* HvEITER(hv) */)
-	    HvLAZYDEL_on(hv);
-	else
-	    hv_free_ent(hv, entry);
-	xhv->xhv_keys--; /* HvKEYS(hv)-- */
 	return sv;
     }
+    if (HvPSEUDO_ENUMERATED(hv))
+	Perl_croak(aTHX_ "Can't access nonexistant key {%s} of restricted hash", key);
+
     if (key != keysave)
 	Safefree(key);
     return Nullsv;
@@ -840,6 +1011,9 @@
     bool is_utf8 = FALSE;
     const char *keysave = key;
 
+    /* this is ugly, but is the easiest way around this being a bool func */
+    PL_recent_nonexists_is_allowed = FALSE;
+
     if (!hv)
 	return 0;
 
@@ -895,7 +1069,16 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	return TRUE;
+
+	/*
+	 * If we find the key, but the value is a placeholder, we return
+	 * false.
+	 */
+	if (HeVAL(entry) == &PL_sv_undef) {
+            PL_recent_nonexists_is_allowed = TRUE;
+            return FALSE;
+        } else
+	    return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -936,6 +1119,9 @@
     bool is_utf8;
     char *keysave;
 
+    /* this is ugly, but is the easiest way around this being a bool func */
+    PL_recent_nonexists_is_allowed = FALSE;
+
     if (!hv)
 	return 0;
 
@@ -988,7 +1174,15 @@
 	    continue;
 	if (key != keysave)
 	    Safefree(key);
-	return TRUE;
+	/*
+	 * If we find the key, but the value is a placeholder, we return
+	 * false.
+	 */
+	if (HeVAL(entry) == &PL_sv_undef) {
+            PL_recent_nonexists_is_allowed = TRUE;
+	    return FALSE;
+        } else
+	    return TRUE;
     }
 #ifdef DYNAMIC_ENV_FETCH  /* is it out there? */
     if (SvRMAGICAL((SV*)hv) && mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -1225,7 +1419,7 @@
 
 	HvMAX(hv)   = hv_max;
 	HvFILL(hv)  = hv_fill;
-	HvKEYS(hv)  = HvKEYS(ohv);
+	HvTOTALKEYS(hv)  = HvTOTALKEYS(ohv);
 	HvARRAY(hv) = ents;
     }
     else {
@@ -1309,7 +1503,8 @@
     xhv = (XPVHV*)SvANY(hv);
     hfreeentries(hv);
     xhv->xhv_fill = 0; /* HvFILL(hv) = 0 */
-    xhv->xhv_keys = 0; /* HvKEYS(hv) = 0 */
+    xhv->xhv_keys = 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*));
@@ -1375,7 +1570,8 @@
     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_keys  = 0;
+    xhv->xhv_placeholders = 0; /* HvPLACEHOLDERS(hv) = 0 */
 
     if (SvRMAGICAL(hv))
 	mg_clear((SV*)hv);
@@ -1385,8 +1581,8 @@
 =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
-currently only meaningful for hashes without tie magic.
+keys in the hash, excluding placeholders (i.e. the same as C<HvKEYS(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
 hash buckets that happen to be in use.  If you still need that esoteric
@@ -1412,7 +1608,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 XHvTOTALKEYS(xhv);
 }
 
 /*
@@ -1476,8 +1672,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 +1693,10 @@
 	}
 	/* 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 */
+	while (entry && HeVAL(entry) == &PL_sv_undef)
+	    entry = 0;
     }
 
     if (oldentry && HvLAZYDEL(hv)) {		/* was deleted earlier? */
@@ -1653,7 +1864,7 @@
 		xhv->xhv_fill--; /* HvFILL(hv)-- */
 	    Safefree(HeKEY_hek(entry));
 	    del_HE(entry);
-	    xhv->xhv_keys--; /* HvKEYS(hv)-- */
+	    xhv->xhv_keys--;
 	}
 	break;
     }
@@ -1715,7 +1926,7 @@
 	HeVAL(entry) = Nullsv;
 	HeNEXT(entry) = *oentry;
 	*oentry = entry;
-	xhv->xhv_keys++; /* HvKEYS(hv)++ */
+	xhv->xhv_keys++;
 	if (i) {				/* initial entry? */
 	    xhv->xhv_fill++; /* HvFILL(hv)++ */
 	    if (xhv->xhv_keys > xhv->xhv_max /* HvKEYS(hv) > HvMAX(hv) */)
--- bleedperl.orig/scope.c	Fri Oct 26 07:09:53 2001
+++ bleedperl/scope.c	Wed Oct 31 23:14:34 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,6 +823,14 @@
 	    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) && ! SvFAKE(sv))
+		    SvREADONLY_off(sv);
+
 		if (SvTHINKFIRST(sv))
 		    sv_force_normal_flags(sv, SV_IMMEDIATE_UNREF);
 		if (SvMAGICAL(sv))
--- bleedperl.orig/sv.c	Sun Oct 28 15:59:51 2001
+++ bleedperl/sv.c	Wed Oct 31 20:37:49 2001
@@ -1417,8 +1417,8 @@
 	SvPVX(sv)	= 0;
 	HvFILL(sv)	= 0;
 	HvMAX(sv)	= 0;
-	HvKEYS(sv)	= 0;
-	SvNVX(sv)	= 0.0;
+	HvTOTALKEYS(sv)	= 0;
+	HvPLACEHOLDERS(sv) = 0;
 	SvMAGIC(sv)	= magic;
 	SvSTASH(sv)	= stash;
 	HvRITER(sv)	= 0;
--- bleedperl.orig/thrdvar.h	Sat Sep 15 06:40:43 2001
+++ bleedperl/thrdvar.h	Wed Oct 31 23:56:16 2001
@@ -261,3 +261,5 @@
 
 PERLVAR(Treg_match_utf8,	bool)		/* was what we matched against utf8 */
 
+PERLVAR(recent_nonexists_is_allowed, bool) /* recent false from exists() is "allowed" */
+
--- bleedperl.orig/ext/Devel/Peek/Peek.t	Thu Sep 27 16:25:56 2001
+++ bleedperl/ext/Devel/Peek/Peek.t	Wed Oct 31 22:33:49 2001
@@ -27,6 +27,7 @@
 	if (open(IN, "peek$$")) {
 	    local $/;
 	    $pattern =~ s/\$ADDR/0x[[:xdigit:]]+/g;
+	    $pattern =~ s/\$FLOAT/(?:\\d*\\.\\d+(?:e[-+]\\d+)?|\\d+)/g;
 	    print $pattern, "\n" if $DEBUG;
 	    my $dump = <IN>;
 	    print $dump, "\n"    if $DEBUG;
@@ -187,10 +188,11 @@
     REFCNT = 2
     FLAGS = \\(SHAREKEYS\\)
     IV = 1
-    NV = 0
+    NV = $FLOAT
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
     KEYS = 1
+    PLACEHOLDERS = 0
     FILL = 1
     MAX = 7
     RITER = -1
@@ -283,6 +285,7 @@
     STASH = $ADDR\\t"Tac"
     ARRAY = 0x0
     KEYS = 0
+    PLACEHOLDERS = 0
     FILL = 0
     MAX = 7
     RITER = -1
@@ -336,10 +339,11 @@
     REFCNT = 2
     FLAGS = \\(SHAREKEYS\\)
     IV = 1
-    NV = 0
+    NV = $FLOAT
     ARRAY = $ADDR  \\(0:7, 1:1\\)
     hash quality = 100.0%
     KEYS = 1
+    PLACEHOLDERS = 0
     FILL = 1
     MAX = 7
     RITER = -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