Integrate:

[ 24692]
Create newSVpv_hek to reduce code duplication where HEKs need to be
turned into SVs

[ 24696]
s/newSVpv_hek/newSVhek/g; # Lousy choice of name

(just the tweak to newSVhek for passing in NULL from)
[ 24697]
Use newSVhek where we're generating SVs from package names
p4raw-link: @24697 on //depot/perl: 5aaec2b4ba9ed3b1a9d1569e09bc40d19ec30f8c
p4raw-link: @24696 on //depot/perl: c1b02ed82fa9b8892ce2668d35b6825f1fd3fb59
p4raw-link: @24692 on //depot/perl: bd08039be6ae803dd509ca33cf404bdcdd4bae99

p4raw-id: //depot/maint-5.8/perl@25509
p4raw-integrated: from //depot/perl@24697 'ignore' pp.c (@24619..) op.c
	(@24654..) toke.c (@24689..)
p4raw-edited: from //depot/perl@24696 'edit in' embed.fnc (@24692..)
p4raw-integrated: from //depot/perl@24696 'edit in' sv.c (@24692..)
	'merge in' proto.h (@24689..)
p4raw-integrated: from //depot/perl@24692 'edit in' embed.h hv.c
	(@24689..) 'merge in' global.sym (@24689..)

diff --git a/embed.fnc b/embed.fnc
index 48fa17d..e677eea 100644 (file)
--- a/embed.fnc
+++ b/embed.fnc
@@ -1554,6 +1554,7 @@ ApR       |OP*    |ck_unpack      |NN OP *o
 #endif
 
 Apd    |bool   |is_utf8_string_loclen|NN const U8 *s|STRLEN len|const U8 **ep|STRLEN *el
+Apda   |SV*    |newSVhek       |const HEK *hek
 
 END_EXTERN_C
 /*

diff --git a/embed.h b/embed.h
index 01a3b48..7aef82c 100644 (file)
--- a/embed.h
+++ b/embed.h
@@ -578,6 +578,7 @@
 #define newSVnv                        Perl_newSVnv
 #define newSVpv                        Perl_newSVpv
 #define newSVpvn               Perl_newSVpvn
+#define newSVhek               Perl_newSVhek
 #define newSVpvn_share         Perl_newSVpvn_share
 #define newSVpvf               Perl_newSVpvf
 #define vnewSVpvf              Perl_vnewSVpvf
@@ -2620,6 +2621,7 @@
 #define newSVnv(a)             Perl_newSVnv(aTHX_ a)
 #define newSVpv(a,b)           Perl_newSVpv(aTHX_ a,b)
 #define newSVpvn(a,b)          Perl_newSVpvn(aTHX_ a,b)
+#define newSVhek(a)            Perl_newSVhek(aTHX_ a)
 #define newSVpvn_share(a,b,c)  Perl_newSVpvn_share(aTHX_ a,b,c)
 #define vnewSVpvf(a,b)         Perl_vnewSVpvf(aTHX_ a,b)
 #define newSVrv(a,b)           Perl_newSVrv(aTHX_ a,b)

diff --git a/global.sym b/global.sym
index 80ff9dd..9524085 100644 (file)
--- a/global.sym
+++ b/global.sym
@@ -320,6 +320,7 @@ Perl_newSVuv
 Perl_newSVnv
 Perl_newSVpv
 Perl_newSVpvn
+Perl_newSVpv_hek
 Perl_newSVpvn_share
 Perl_newSVpvf
 Perl_vnewSVpvf

diff --git a/hv.c b/hv.c
index 10d5658..114c3d1 100644 (file)
--- a/hv.c
+++ b/hv.c
@@ -1850,39 +1850,7 @@ see C<hv_iterinit>.
 SV *
 Perl_hv_iterkeysv(pTHX_ register HE *entry)
 {
-    if (HeKLEN(entry) != HEf_SVKEY) {
-        HEK *hek = HeKEY_hek(entry);
-        const int flags = HEK_FLAGS(hek);
-        SV *sv;
-
-        if (flags & HVhek_WASUTF8) {
-            /* Trouble :-)
-               Andreas would like keys he put in as utf8 to come back as utf8
-            */
-            STRLEN utf8_len = HEK_LEN(hek);
-            U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
-
-            sv = newSVpvn ((char*)as_utf8, utf8_len);
-            SvUTF8_on (sv);
-           Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
-       } else if (flags & HVhek_REHASH) {
-           /* We don't have a pointer to the hv, so we have to replicate the
-              flag into every HEK. This hv is using custom a hasing
-              algorithm. Hence we can't return a shared string scalar, as
-              that would contain the (wrong) hash value, and might get passed
-              into an hv routine with a regular hash  */
-
-            sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
-           if (HEK_UTF8(hek))
-               SvUTF8_on (sv);
-       } else {
-            sv = newSVpvn_share(HEK_KEY(hek),
-                                (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
-                                HEK_HASH(hek));
-        }
-        return sv_2mortal(sv);
-    }
-    return sv_mortalcopy(HeKEY_sv(entry));
+    return sv_2mortal(newSVhek(HeKEY_hek(entry)));
 }
 
 /*

diff --git a/proto.h b/proto.h
index d65842b..4cd51e9 100644 (file)
--- a/proto.h
+++ b/proto.h
@@ -1048,6 +1048,10 @@ PERL_CALLCONV SV*        Perl_newSVpvn(pTHX_ const char* s, STRLEN len)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;
 
+PERL_CALLCONV SV*      Perl_newSVhek(pTHX_ const HEK *hek)
+                       __attribute__malloc__
+                       __attribute__warn_unused_result__;
+
 PERL_CALLCONV SV*      Perl_newSVpvn_share(pTHX_ const char* s, I32 len, U32 hash)
                        __attribute__malloc__
                        __attribute__warn_unused_result__;

diff --git a/sv.c b/sv.c
index e160779..14cbfbd 100644 (file)
--- a/sv.c
+++ b/sv.c
@@ -6923,6 +6923,61 @@ Perl_newSVpvn(pTHX_ const char *s, STRLEN len)
     return sv;
 }
 
+
+/*
+=for apidoc newSVpv_hek
+
+Creates a new SV from the hash key structure.  It will generate scalars that
+point to the shared string table where possible. Returns a new (undefined)
+SV if the hek is NULL.
+
+=cut
+*/
+
+SV *
+Perl_newSVhek(pTHX_ const HEK *hek)
+{
+    if (!hek) {
+       SV *sv;
+
+       new_SV(sv);
+       return sv;
+    }
+
+    if (HEK_LEN(hek) == HEf_SVKEY) {
+       return newSVsv(*(SV**)HEK_KEY(hek));
+    } else {
+       const int flags = HEK_FLAGS(hek);
+       if (flags & HVhek_WASUTF8) {
+           /* Trouble :-)
+              Andreas would like keys he put in as utf8 to come back as utf8
+           */
+           STRLEN utf8_len = HEK_LEN(hek);
+           U8 *as_utf8 = bytes_to_utf8 ((U8*)HEK_KEY(hek), &utf8_len);
+           SV *sv = newSVpvn ((char*)as_utf8, utf8_len);
+
+           SvUTF8_on (sv);
+           Safefree (as_utf8); /* bytes_to_utf8() allocates a new string */
+           return sv;
+       } else if (flags & HVhek_REHASH) {
+           /* We don't have a pointer to the hv, so we have to replicate the
+              flag into every HEK. This hv is using custom a hasing
+              algorithm. Hence we can't return a shared string scalar, as
+              that would contain the (wrong) hash value, and might get passed
+              into an hv routine with a regular hash  */
+
+           SV *sv = newSVpvn (HEK_KEY(hek), HEK_LEN(hek));
+           if (HEK_UTF8(hek))
+               SvUTF8_on (sv);
+           return sv;
+       }
+       /* This will be overwhelminly the most common case.  */
+       return newSVpvn_share(HEK_KEY(hek),
+                             (HEK_UTF8(hek) ? -HEK_LEN(hek) : HEK_LEN(hek)),
+                             HEK_HASH(hek));
+    }
+}
+
 /*
 =for apidoc newSVpvn_share