# define VMG_COMPAT_HASH_DELETE_NOUVAR_VOID 0
#endif
+#if VMG_HAS_PERL(5, 17, 0)
+# define VMG_COMPAT_CODE_COPY_CLONE 1
+#else
+# define VMG_COMPAT_CODE_COPY_CLONE 0
+#endif
+
#if VMG_HAS_PERL(5, 13, 2)
# define VMG_COMPAT_GLOB_GET 1
#else
SV *old_err = NULL;
if (SvTRUE(ERRSV)) {
- old_err = ERRSV;
- ERRSV = newSV(0);
+ old_err = newSVsv(ERRSV);
+ sv_setsv(ERRSV, &PL_sv_undef);
}
cxix = (cxstack_ix < cxstack_max) ? (cxstack_ix + 1) : Perl_cxinc(aTHX);
cxstack[cxix] = saved_cx;
if (SvTRUE(ERRSV)) {
- if (old_err) {
- sv_setsv(old_err, ERRSV);
- SvREFCNT_dec(ERRSV);
- ERRSV = old_err;
- }
+ SvREFCNT_dec(old_err);
+
if (IN_PERL_COMPILETIME) {
if (!PL_in_eval) {
if (PL_errors)
}
} else {
if (old_err) {
- SvREFCNT_dec(ERRSV);
- ERRSV = old_err;
+ sv_setsv(ERRSV, old_err);
+ SvREFCNT_dec(old_err);
}
}
/* --- Stolen chunk of B --------------------------------------------------- */
typedef enum {
- OPc_NULL = 0,
- OPc_BASEOP = 1,
- OPc_UNOP = 2,
- OPc_BINOP = 3,
- OPc_LOGOP = 4,
- OPc_LISTOP = 5,
- OPc_PMOP = 6,
- OPc_SVOP = 7,
- OPc_PADOP = 8,
- OPc_PVOP = 9,
- OPc_LOOP = 10,
- OPc_COP = 11,
- OPc_MAX = 12
+ OPc_NULL,
+ OPc_BASEOP,
+ OPc_UNOP,
+ OPc_BINOP,
+ OPc_LOGOP,
+ OPc_LISTOP,
+ OPc_PMOP,
+ OPc_SVOP,
+ OPc_PADOP,
+ OPc_PVOP,
+ OPc_LOOP,
+ OPc_COP,
+#if VMG_HAS_PERL(5, 21, 5)
+ OPc_METHOP,
+#endif
+ OPc_MAX
} opclass;
STATIC const char *const vmg_opclassnames[] = {
"B::PADOP",
"B::PVOP",
"B::LOOP",
- "B::COP"
+ "B::COP",
+#if VMG_HAS_PERL(5, 21, 5)
+ "B::METHOP",
+#endif
+ NULL
};
STATIC opclass vmg_opclass(const OP *o) {
return OPc_BASEOP;
else
return OPc_PVOP;
+#if VMG_HAS_PERL(5, 21, 5)
+ case OA_METHOP:
+ return OPc_METHOP;
+#endif
}
return OPc_BASEOP;
SVOP *o = cSVOPx(PL_op);
if (o->op_sv) {
- SvREFCNT_dec(ERRSV);
- ERRSV = o->op_sv;
+ sv_setsv(ERRSV, o->op_sv);
+ SvREFCNT_dec(o->op_sv);
o->op_sv = NULL;
}
#endif /* VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */
STATIC int vmg_propagate_errsv_free(pTHX_ SV *sv, MAGIC *mg) {
- if (mg->mg_obj) {
- ERRSV = mg->mg_obj;
- mg->mg_obj = NULL;
- mg->mg_flags &= ~MGf_REFCOUNTED;
- }
+ if (mg->mg_obj)
+ sv_setsv(ERRSV, mg->mg_obj);
return 0;
}
SV *guard = sv_newmortal();
sv_magicext(guard, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl,
NULL, 0);
+ SvREFCNT_dec(errsv);
}
#else /* !VMG_PROPAGATE_ERRSV_NEEDS_TRAMPOLINE */
# if !VMG_HAS_PERL(5, 8, 9)
SV *guard = sv_newmortal();
sv_magicext(guard, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl,
NULL, 0);
+ SvREFCNT_dec(errsv);
}
# else
sv_magicext(ERRSV, errsv, PERL_MAGIC_ext, &vmg_propagate_errsv_vtbl,
keysv = newSVpvn(key, keylen);
}
+ if (SvTYPE(sv) >= SVt_PVCV)
+ nsv = sv_2mortal(newRV_inc(nsv));
+
ret = vmg_cb_call3(w->cb_copy, w->opinfo, sv, mg->mg_obj, keysv, nsv);
if (keylen != HEf_SVKEY) {
newSVuv(VMG_COMPAT_ARRAY_UNDEF_CLEAR));
newCONSTSUB(stash, "VMG_COMPAT_HASH_DELETE_NOUVAR_VOID",
newSVuv(VMG_COMPAT_HASH_DELETE_NOUVAR_VOID));
+ newCONSTSUB(stash, "VMG_COMPAT_CODE_COPY_CLONE",
+ newSVuv(VMG_COMPAT_CODE_COPY_CLONE));
newCONSTSUB(stash, "VMG_COMPAT_GLOB_GET", newSVuv(VMG_COMPAT_GLOB_GET));
newCONSTSUB(stash, "VMG_PERL_PATCHLEVEL", newSVuv(VMG_PERL_PATCHLEVEL));
newCONSTSUB(stash, "VMG_THREADSAFE", newSVuv(VMG_THREADSAFE));