From: Vincent Pit Date: Mon, 29 Sep 2014 16:30:41 +0000 (+0200) Subject: Use the new CLONE_PARAMS API with perl 5.13.2 X-Git-Tag: v0.33~2 X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=f9e9f900acf1683017658778d0c234331fd36618;p=perl%2Fmodules%2Findirect.git Use the new CLONE_PARAMS API with perl 5.13.2 --- diff --git a/indirect.xs b/indirect.xs index 5cd420c..7c264c5 100644 --- a/indirect.xs +++ b/indirect.xs @@ -271,52 +271,47 @@ START_MY_CXT #if I_THREADSAFE -STATIC SV *indirect_clone(pTHX_ SV *sv, tTHX owner) { -#define indirect_clone(S, O) indirect_clone(aTHX_ (S), (O)) - CLONE_PARAMS param; - AV *stashes = NULL; - SV *dupsv; - - if (!sv) - return NULL; - - if (SvTYPE(sv) == SVt_PVHV && HvNAME_get(sv)) - stashes = newAV(); - - param.stashes = stashes; - param.flags = 0; - param.proto_perl = owner; - - dupsv = sv_dup(sv, ¶m); - - if (stashes) { - av_undef(stashes); - SvREFCNT_dec(stashes); - } - - return SvREFCNT_inc(dupsv); -} +typedef struct { + ptable *tbl; +#if I_HAS_PERL(5, 13, 2) + CLONE_PARAMS *params; +#else + CLONE_PARAMS params; +#endif +} indirect_ptable_clone_ud; + +#if I_HAS_PERL(5, 13, 2) +# define indirect_ptable_clone_ud_init(U, T, O) \ + (U).tbl = (T); \ + (U).params = Perl_clone_params_new((O), aTHX) +# define indirect_ptable_clone_ud_deinit(U) Perl_clone_params_del((U).params) +# define indirect_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), (U)->params)) +#else +# define indirect_ptable_clone_ud_init(U, T, O) \ + (U).tbl = (T); \ + (U).params.stashes = newAV(); \ + (U).params.flags = 0; \ + (U).params.proto_perl = (O) +# define indirect_ptable_clone_ud_deinit(U) SvREFCNT_dec((U).params.stashes) +# define indirect_dup_inc(S, U) SvREFCNT_inc(sv_dup((S), &((U)->params))) +#endif STATIC void indirect_ptable_clone(pTHX_ ptable_ent *ent, void *ud_) { - my_cxt_t *ud = ud_; - indirect_hint_t *h1 = ent->val; - indirect_hint_t *h2; - - if (ud->owner == aTHX) - return; + indirect_ptable_clone_ud *ud = ud_; + indirect_hint_t *h1 = ent->val; + indirect_hint_t *h2; #if I_HINT_STRUCT - h2 = PerlMemShared_malloc(sizeof *h2); - h2->code = indirect_clone(h1->code, ud->owner); + h2 = PerlMemShared_malloc(sizeof *h2); + h2->code = indirect_dup_inc(h1->code, ud); #if I_WORKAROUND_REQUIRE_PROPAGATION - h2->require_tag = PTR2IV(indirect_clone(INT2PTR(SV *, h1->require_tag), - ud->owner)); + h2->require_tag = PTR2IV(indirect_dup_inc(INT2PTR(SV *, h1->require_tag), ud)); #endif #else /* I_HINT_STRUCT */ - h2 = indirect_clone(h1, ud->owner); + h2 = indirect_dup_inc(h1, ud); #endif /* !I_HINT_STRUCT */ @@ -1024,12 +1019,13 @@ PREINIT: GV *gv; PPCODE: { - my_cxt_t ud; + indirect_ptable_clone_ud ud; dMY_CXT; - ud.tbl = t = ptable_new(); - ud.owner = MY_CXT.owner; + t = ptable_new(); + indirect_ptable_clone_ud_init(ud, t, MY_CXT.owner); ptable_walk(MY_CXT.tbl, indirect_ptable_clone, &ud); - global_code_dup = indirect_clone(MY_CXT.global_code, MY_CXT.owner); + global_code_dup = indirect_dup_inc(MY_CXT.global_code, &ud); + indirect_ptable_clone_ud_deinit(ud); } { MY_CXT_CLONE;