STATIC U32 vmg_svt_len(pTHX_ SV *sv, MAGIC *mg) {
SV *svr;
- I32 len, has_array;
- U32 ret;
+ U32 len, ret;
+ svtype t = SvTYPE(sv);
dSP;
- has_array = SvTYPE(sv) == SVt_PVAV;
-
ENTER;
SAVETMPS;
EXTEND(SP, 3);
PUSHs(sv_2mortal(newRV_inc(sv)));
PUSHs(mg->mg_obj ? mg->mg_obj : &PL_sv_undef);
- if (has_array) {
+ if (t < SVt_PVAV) {
+ STRLEN l;
+ U8 *s = (U8 *) SvPV_const(sv, l);
+ if (DO_UTF8(sv))
+ len = utf8_length(s, s + l);
+ else
+ len = l;
+ mPUSHu(len);
+ } else if (t == SVt_PVAV) {
len = av_len((AV *) sv) + 1;
- mPUSHi(len);
+ mPUSHu(len);
} else {
len = 0;
PUSHs(&PL_sv_undef);
FREETMPS;
LEAVE;
- return has_array ? ret - 1 : ret;
+ return t == SVt_PVAV ? ret - 1 : ret;
}
STATIC int vmg_svt_clear(pTHX_ SV *sv, MAGIC *mg) {
if (SvTYPE(wiz) == SVTYPEMASK)
return 0;
- /* So that it can survive tmp cleanup in vmg_cb_call */
+ /* So that it survives the temp cleanup in vmg_cb_call */
SvREFCNT_inc(sv);
#if !VMG_HAS_PERL_MAINT(5, 11, 0, 32686)
SvMAGIC_set(sv, mg);
#endif
- /* Perl_mg_free will get rid of the magic and decrement mg->mg_obj and
- * mg->mg_ptr reference count */
ret = vmg_cb_call1e(SV2MGWIZ(wiz)->cb_free, sv, mg->mg_obj);
/* Calling SvREFCNT_dec() will trigger destructors in an infinite loop, so
* we have to rely on SvREFCNT() being a lvalue. Heck, even the core does it */
--SvREFCNT(sv);
+ /* Perl_mg_free will get rid of the magic and decrement mg->mg_obj and
+ * mg->mg_ptr reference count */
return ret;
}
continue;
case 2:
if (!newkey)
- newkey = key = umg->mg_obj = sv_2mortal(newSVsv(umg->mg_obj));
+ newkey = key = umg->mg_obj = sv_mortalcopy(umg->mg_obj);
}
switch (action) {
case 0:
newCONSTSUB(stash, "VMG_THREADSAFE", newSVuv(VMG_THREADSAFE));
}
+#if VMG_THREADSAFE
+
void
CLONE(...)
PROTOTYPE: DISABLE
PREINIT:
HV *hv;
CODE:
-#if VMG_THREADSAFE
{
HE *key;
dMY_CXT;
MY_CXT_CLONE;
MY_CXT = hv;
}
+
#endif /* VMG_THREADSAFE */
SV *_wizard(...)