Perl_unsharepvn() was no longer being used in core, and changes to

S_unshare_hek_or_pvn() had broken it. Now fixed and tested.

p4raw-id: //depot/perl@27761

diff --git a/ext/XS/APItest/APItest.xs b/ext/XS/APItest/APItest.xs
index 3a31ec9..ff0a8fb 100644 (file)
--- a/ext/XS/APItest/APItest.xs
+++ b/ext/XS/APItest/APItest.xs
@@ -221,7 +221,26 @@ test_hv_delayfree_ent()
        PPCODE:
        test_freeent(&Perl_hv_delayfree_ent);
        XSRETURN(4);
-           
+
+SV *
+test_share_unshare_pvn(input)
+       PREINIT:
+       SV *output;
+       STRLEN len;
+       U32 hash;
+       char *pvx;
+       char *p;
+       INPUT:
+       SV *input
+       CODE:
+       pvx = SvPV(input, len);
+       PERL_HASH(hash, pvx, len);
+       p = sharepvn(pvx, len, hash);
+       RETVAL = newSVpvn(p, len);
+       unsharepvn(p, len, hash);
+       OUTPUT:
+       RETVAL
+       
 =pod
 
 sub TIEHASH  { bless {}, $_[0] }

diff --git a/ext/XS/APItest/t/hash.t b/ext/XS/APItest/t/hash.t
index 880d972..2a0f9f8 100644 (file)
--- a/ext/XS/APItest/t/hash.t
+++ b/ext/XS/APItest/t/hash.t
@@ -89,6 +89,12 @@ main_tests (\@keys, \@testkeys, ' [utf8 hash]');
     is_deeply([&XS::APItest::Hash::test_hv_delayfree_ent], [2,2,2,1],
              "hv_delayfree_ent keeps the value around until FREETMPS");
 }
+
+foreach my $in ("", "N", "a\0b") {
+    my $got = XS::APItest::Hash::test_share_unshare_pvn($in);
+    is ($got, $in, "test_share_unshare_pvn");
+}
+
 exit;
 
 ################################   The End   ################################

diff --git a/hv.c b/hv.c
index fe74e87..bc64df4 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -2307,7 +2307,6 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     HE *entry;
     register HE **oentry;
     HE **first;
-    bool found = 0;
     bool is_utf8 = FALSE;
     int k_flags = 0;
     const char * const save = str;
@@ -2356,10 +2355,8 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     if (he) {
        const HE *const he_he = &(he->shared_he_he);
         for (entry = *oentry; entry; oentry = &HeNEXT(entry), entry = *oentry) {
-            if (entry != he_he)
-                continue;
-            found = 1;
-            break;
+            if (entry == he_he)
+                break;
         }
     } else {
         const int flags_masked = k_flags & HVhek_MASK;
@@ -2372,13 +2369,12 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
                 continue;
             if (HeKFLAGS(entry) != flags_masked)
                 continue;
-            found = 1;
             break;
         }
     }
 
-    if (found) {
-        if (--he->shared_he_he.he_valu.hent_refcount == 0) {
+    if (entry) {
+        if (--entry->he_valu.hent_refcount == 0) {
             *oentry = HeNEXT(entry);
             if (!*first) {
                /* There are now no entries in our slot.  */
@@ -2390,7 +2386,7 @@ S_unshare_hek_or_pvn(pTHX_ const HEK *hek, const char *str, I32 len, U32 hash)
     }
 
     UNLOCK_STRTAB_MUTEX;
-    if (!found && ckWARN_d(WARN_INTERNAL))
+    if (!entry && ckWARN_d(WARN_INTERNAL))
        Perl_warner(aTHX_ packWARN(WARN_INTERNAL),
                     "Attempt to free non-existent shared string '%s'%s"
                     pTHX__FORMAT,