(void)SvPOK_only(dstr);
if (
-#ifdef PERL_COPY_ON_WRITE
(sflags & (SVf_FAKE | SVf_READONLY)) != (SVf_FAKE | SVf_READONLY)
&&
-#endif
!(isSwipe =
(sflags & SVs_TEMP) && /* slated for free anyway? */
!(sflags & SVf_OOK) && /* and not involved in OOK hack? */
} else {
/* If PERL_COPY_ON_WRITE is not defined, then isSwipe will always
be true in here. */
-#ifdef PERL_COPY_ON_WRITE
/* Either it's a shared hash key, or it's suitable for
copy-on-write or we can swipe the string. */
if (DEBUG_C_TEST) {
sv_dump(sstr);
sv_dump(dstr);
}
+#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
/* I believe I should acquire a global SV mutex if
it's a COW sv (not a shared hash key) to stop
Safefree(SvPVX_const(dstr));
}
-#ifdef PERL_COPY_ON_WRITE
if (!isSwipe) {
/* making another shared SV. */
STRLEN cur = SvCUR(sstr);
STRLEN len = SvLEN(sstr);
assert (SvTYPE(dstr) >= SVt_PVIV);
+#ifdef PERL_COPY_ON_WRITE
if (len) {
/* SvIsCOW_normal */
/* splice us in between source and next-after-source. */
SV_COW_NEXT_SV_SET(dstr, SV_COW_NEXT_SV(sstr));
SV_COW_NEXT_SV_SET(sstr, dstr);
SvPV_set(dstr, SvPVX(sstr));
- } else {
+ } else
+#endif
+ {
/* SvIsCOW_shared_hash */
UV hash = SvUVX(sstr);
DEBUG_C(PerlIO_printf(Perl_debug_log,
/* Relesase a global SV mutex. */
}
else
-#endif
{ /* Passes the swipe test. */
SvPV_set(dstr, SvPVX(sstr));
SvLEN_set(dstr, SvLEN(sstr));
#else
if (SvREADONLY(sv)) {
if (SvFAKE(sv)) {
- char *pvx = SvPVX_const(sv);
+ const char *pvx = SvPVX_const(sv);
const int is_utf8 = SvUTF8(sv);
STRLEN len = SvCUR(sv);
U32 hash = SvUVX(sv);
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
static void
do_mark_cloneable_stash(pTHX_ SV *sv)
{
- const char *hvname = HvNAME_get((HV*)sv);
+ const HEK *hvname = HvNAME_HEK((HV*)sv);
if (hvname) {
GV* cloner = gv_fetchmethod_autoload((HV*)sv, "CLONE_SKIP", 0);
- STRLEN len = HvNAMELEN_get((HV*)sv);
SvFLAGS(sv) |= SVphv_CLONEABLE; /* clone objects by default */
if (cloner && GvCV(cloner)) {
dSP;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpvn(hvname, len)));
+ XPUSHs(sv_2mortal(newSVhek(hvname)));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_SCALAR);
SPAGAIN;
* constants; they need to be allocated as common memory and just
* their pointers copied. */
+ IV i;
CLONE_PARAMS clone_params;
CLONE_PARAMS* param = &clone_params;
ENTER;
SAVETMPS;
PUSHMARK(SP);
- XPUSHs(sv_2mortal(newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash))));
+ XPUSHs(sv_2mortal(newSVhek(HvNAME_HEK(stash))));
PUTBACK;
call_sv((SV*)GvCV(cloner), G_DISCARD);
FREETMPS;