X-Git-Url: http://git.vpit.fr/?a=blobdiff_plain;f=Magic.xs;h=9a07ac57e46d6e0785c665d7ebe5e4bdbd83c047;hb=6465e2c2aa07f44029809c486baeb1fd81aaa7eb;hp=9bdcca5b61643abb21f021890247bf1cf2e8b56e;hpb=7f3b1ec01ca3856b1d5670ab9795cf0e91ba8928;p=perl%2Fmodules%2FVariable-Magic.git diff --git a/Magic.xs b/Magic.xs index 9bdcca5..9a07ac5 100644 --- a/Magic.xs +++ b/Magic.xs @@ -139,6 +139,12 @@ # define VMG_COMPAT_SCALAR_LENGTH_NOLEN 0 #endif +#if VMG_HAS_PERL(5, 17, 4) +# define VMG_COMPAT_SCALAR_NOLEN 1 +#else +# define VMG_COMPAT_SCALAR_NOLEN 0 +#endif + /* Applied to dev-5.9 as 25854, integrated to maint-5.8 as 28160, partially * reverted to dev-5.11 as 9cdcb38b */ #if VMG_HAS_PERL_MAINT(5, 8, 9, 28160) || VMG_HAS_PERL_MAINT(5, 9, 3, 25854) || VMG_HAS_PERL(5, 10, 0) @@ -181,6 +187,12 @@ # 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 @@ -325,19 +337,22 @@ STATIC I32 vmg_call_sv(pTHX_ SV *sv, I32 flags, int (*cleanup)(pTHX_ void *), vo /* --- 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[] = { @@ -352,7 +367,11 @@ 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) { @@ -424,6 +443,10 @@ 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; @@ -1554,6 +1577,9 @@ STATIC int vmg_svt_copy(pTHX_ SV *sv, MAGIC *mg, SV *nsv, const char *key, VMG_S 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) { @@ -1799,6 +1825,8 @@ BOOT: newCONSTSUB(stash, "VMG_UVAR", newSVuv(VMG_UVAR)); newCONSTSUB(stash, "VMG_COMPAT_SCALAR_LENGTH_NOLEN", newSVuv(VMG_COMPAT_SCALAR_LENGTH_NOLEN)); + newCONSTSUB(stash, "VMG_COMPAT_SCALAR_NOLEN", + newSVuv(VMG_COMPAT_SCALAR_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN", newSVuv(VMG_COMPAT_ARRAY_PUSH_NOLEN)); newCONSTSUB(stash, "VMG_COMPAT_ARRAY_PUSH_NOLEN_VOID", @@ -1809,6 +1837,8 @@ BOOT: 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));