Mention that "make test_harness" lets messages sent through
[p5sagit/p5-mst-13.2.git] / hv.c
diff --git a/hv.c b/hv.c
index 22b8cf2..4300e36 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1,6 +1,6 @@
 /*    hv.c
  *
- *    Copyright (c) 1991-2002, Larry Wall
+ *    Copyright (c) 1991-2003, Larry Wall
  *
  *    You may distribute under the terms of either the GNU General Public
  *    License or the Artistic License, as specified in the README file.
@@ -409,8 +409,13 @@ Perl_hv_fetch_ent(pTHX_ HV *hv, SV *keysv, I32 lval, register U32 hash)
             flags |= HVhek_WASUTF8 | HVhek_FREEKEY;
     }
 
-    if (!hash)
-       PERL_HASH(hash, key, klen);
+    if (!hash) {
+        if SvIsCOW_shared_hash(keysv) {
+            hash = SvUVX(keysv);
+        } else {
+            PERL_HASH(hash, key, klen);
+        }
+    }
 
     /* entry = (HvARRAY(hv))[hash & (I32) HvMAX(hv)]; */
     entry = ((HE**)xhv->xhv_array)[hash & (I32) xhv->xhv_max];
@@ -501,7 +506,15 @@ NULL if the operation failed or if the value did not need to be actually
 stored within the hash (as in the case of tied hashes).  Otherwise it can
 be dereferenced to get the original C<SV*>.  Note that the caller is
 responsible for suitably incrementing the reference count of C<val> before
-the call, and decrementing it if the function returned NULL.
+the call, and decrementing it if the function returned NULL.  Effectively
+a successful hv_store takes ownership of one reference to C<val>.  This is
+usually what you want; a newly created SV has a reference count of one, so
+if all your code does is create SVs then store them in a hash, hv_store
+will own the only reference to the new SV, and your code doesn't need to do
+anything further to tidy up.  hv_store is not implemented as a call to
+hv_store_ent, and does not create a temporary SV for the key, so if your
+key data is not already in SV form then use hv_store in preference to
+hv_store_ent.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
@@ -676,7 +689,17 @@ stored within the hash (as in the case of tied hashes).  Otherwise the
 contents of the return value can be accessed using the C<He?> macros
 described here.  Note that the caller is responsible for suitably
 incrementing the reference count of C<val> before the call, and
-decrementing it if the function returned NULL.
+decrementing it if the function returned NULL.  Effectively a successful
+hv_store_ent takes ownership of one reference to C<val>.  This is
+usually what you want; a newly created SV has a reference count of one, so
+if all your code does is create SVs then store them in a hash, hv_store
+will own the only reference to the new SV, and your code doesn't need to do
+anything further to tidy up.  Note that hv_store_ent only reads the C<key>;
+unlike C<val> it does not take ownership of it, so maintaining the correct
+reference count on C<key> is entirely the caller's responsibility.  hv_store
+is not implemented as a call to hv_store_ent, and does not create a temporary
+SV for the key, so if your key data is not already in SV form then use
+hv_store in preference to hv_store_ent.
 
 See L<perlguts/"Understanding the Magic of Tied Hashes and Arrays"> for more
 information on how to use this function on tied hashes.
@@ -737,8 +760,13 @@ Perl_hv_store_ent(pTHX_ HV *hv, SV *keysv, SV *val, U32 hash)
         HvHASKFLAGS_on((SV*)hv);
     }
 
-    if (!hash)
-       PERL_HASH(hash, key, klen);
+    if (!hash) {
+        if SvIsCOW_shared_hash(keysv) {
+            hash = SvUVX(keysv);
+        } else {
+            PERL_HASH(hash, key, klen);
+        }
+    }
 
     if (!xhv->xhv_array /* !HvARRAY(hv) */)
        Newz(505, xhv->xhv_array /* HvARRAY(hv) */,
@@ -840,8 +868,8 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
     if (!hv)
        return Nullsv;
     if (klen < 0) {
-      klen = -klen;
-      is_utf8 = TRUE;
+       klen = -klen;
+       is_utf8 = TRUE;
     }
     if (SvRMAGICAL(hv)) {
        bool needs_copy;
@@ -850,7 +878,9 @@ Perl_hv_delete(pTHX_ HV *hv, const char *key, I32 klen, I32 flags)
 
        if (needs_copy && (svp = hv_fetch(hv, key, klen, TRUE))) {
            sv = *svp;
-           mg_clear(sv);
+           if (SvMAGICAL(sv)) {
+               mg_clear(sv);
+           }
            if (!needs_store) {
                if (mg_find(sv, PERL_MAGIC_tiedelem)) {
                    /* No longer an element */
@@ -1003,7 +1033,9 @@ Perl_hv_delete_ent(pTHX_ HV *hv, SV *keysv, I32 flags, U32 hash)
 
        if (needs_copy && (entry = hv_fetch_ent(hv, keysv, TRUE, hash))) {
            sv = HeVAL(entry);
-           mg_clear(sv);
+           if (SvMAGICAL(sv)) {
+               mg_clear(sv);
+           }
            if (!needs_store) {
                if (mg_find(sv, PERL_MAGIC_tiedelem)) {
                    /* No longer an element */
@@ -1158,7 +1190,7 @@ Perl_hv_exists(pTHX_ HV *hv, const char *key, I32 klen)
            sv = sv_newmortal();
            mg_copy((SV*)hv, sv, key, klen);
            magic_existspack(sv, mg_find(sv, PERL_MAGIC_tiedelem));
-           return SvTRUE(sv);
+           return (bool)SvTRUE(sv);
        }
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -1262,7 +1294,7 @@ Perl_hv_exists_ent(pTHX_ HV *hv, SV *keysv, U32 hash)
            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);
+          return (bool)SvTRUE(svret);
        }
 #ifdef ENV_IS_CASELESS
        else if (mg_find((SV*)hv, PERL_MAGIC_env)) {
@@ -1707,6 +1739,8 @@ Perl_hv_undef(pTHX_ HV *hv)
     hfreeentries(hv);
     Safefree(xhv->xhv_array /* HvARRAY(hv) */);
     if (HvNAME(hv)) {
+        if(PL_stashcache) 
+            hv_delete_ent(PL_stashcache, sv_2mortal(newSVpv(HvNAME(hv),0)), G_DISCARD, 0);
        Safefree(HvNAME(hv));
        HvNAME(hv) = 0;
     }
@@ -1845,6 +1879,7 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        Newz(506, xhv->xhv_array /* HvARRAY(hv) */,
             PERL_HV_ARRAY_ALLOC_BYTES(xhv->xhv_max+1 /* HvMAX(hv)+1 */),
             char);
+    /* At start of hash, entry is NULL.  */
     if (entry)
     {
        entry = HeNEXT(entry);
@@ -1859,8 +1894,11 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        }
     }
     while (!entry) {
+       /* OK. Come to the end of the current list.  Grab the next one.  */
+
        xhv->xhv_riter++; /* HvRITER(hv)++ */
        if (xhv->xhv_riter > (I32)xhv->xhv_max /* HvRITER(hv) > HvMAX(hv) */) {
+           /* There is no next one.  End of the hash.  */
            xhv->xhv_riter = -1; /* HvRITER(hv) = -1 */
            break;
        }
@@ -1868,10 +1906,14 @@ Perl_hv_iternext_flags(pTHX_ HV *hv, I32 flags)
        entry = ((HE**)xhv->xhv_array)[xhv->xhv_riter];
 
         if (!(flags & HV_ITERNEXT_WANTPLACEHOLDERS)) {
-            /* if we have an entry, but it's a placeholder, don't count it */
-            if (entry && HeVAL(entry) == &PL_sv_undef)
-                entry = 0;
-        }
+            /* If we have an entry, but it's a placeholder, don't count it.
+              Try the next.  */
+           while (entry && HeVAL(entry) == &PL_sv_undef)
+               entry = HeNEXT(entry);
+       }
+       /* Will loop again if this linked list starts NULL
+          (for HV_ITERNEXT_WANTPLACEHOLDERS)
+          or if we run through it and find only placeholders.  */
     }
 
     if (oldentry && HvLAZYDEL(hv)) {           /* was deleted earlier? */
@@ -1935,6 +1977,7 @@ Perl_hv_iterkeysv(pTHX_ register HE *entry)
 
             sv = newSVpvn ((char*)as_utf8, utf8_len);
             SvUTF8_on (sv);
+           Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
         } else {
             sv = newSVpvn_share(HEK_KEY(hek),
                                 (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),