X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2Findirect.git;a=blobdiff_plain;f=indirect.xs;h=8e6c789b1b0098315650bf8b05193aac0eb0c77e;hp=57e78e1c315cce3273b2089a0909b28e401297a6;hb=4cb0e2cc26fbe39a7a040b090b1a1e6c2380af0f;hpb=5d8477b589d7ed4c4571111036e5b237ad13f6a9 diff --git a/indirect.xs b/indirect.xs index 57e78e1..8e6c789 100644 --- a/indirect.xs +++ b/indirect.xs @@ -35,6 +35,10 @@ # define SvPVX_const SvPVX #endif +#ifndef SvREFCNT_inc_simple_NN +# define SvREFCNT_inc_simple_NN SvREFCNT_inc +#endif + #ifndef sv_catpvn_nomg # define sv_catpvn_nomg sv_catpvn #endif @@ -260,12 +264,21 @@ STATIC void indirect_thread_cleanup(pTHX_ void *ud) { STATIC SV *indirect_tag(pTHX_ SV *value) { #define indirect_tag(V) indirect_tag(aTHX_ (V)) indirect_hint_t *h; + SV *code = NULL; dMY_CXT; - value = SvOK(value) && SvROK(value) ? SvRV(value) : NULL; + if (SvOK(value) && SvROK(value)) { + value = SvRV(value); + if (SvTYPE(value) >= SVt_PVCV) { + code = value; + if (CvANON(code) && !CvCLONED(code)) + CvCLONE_on(code); + SvREFCNT_inc_simple_NN(code); + } + } h = PerlMemShared_malloc(sizeof *h); - h->code = SvREFCNT_inc(value); + h->code = code; #if I_WORKAROUND_REQUIRE_PROPAGATION {