From: Vincent Pit Date: Mon, 19 Apr 2010 22:46:22 +0000 (+0200) Subject: Store the configure object into the map X-Git-Url: http://git.vpit.fr/?a=commitdiff_plain;h=159088ccddecdea45fdae8093319b41c097adc86;p=perl%2Fmodules%2FSub-Op.git Store the configure object into the map And introduce SUB_OP_REGISTER_STEAL. --- diff --git a/Op.xs b/Op.xs index c5be45b..17fa468 100644 --- a/Op.xs +++ b/Op.xs @@ -126,6 +126,9 @@ void sub_op_init(sub_op_config_t *c) { void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) { SV *key = newSViv(PTR2IV(c->pp)); + if (!(flags & SUB_OP_REGISTER_STEAL)) + c = sub_op_dup(aTHX_ c); + if (!PL_custom_op_names) PL_custom_op_names = newHV(); (void) hv_store_ent(PL_custom_op_names, key, newSVpv(c->name, c->namelen), 0); @@ -134,15 +137,11 @@ void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags) { PL_custom_op_descs = newHV(); (void) hv_store_ent(PL_custom_op_descs, key, newSVpv(c->name, c->namelen), 0); - if (c->check) { - SV *check = newSViv(PTR2IV(c->check)); - sv_magicext(key, check, PERL_MAGIC_ext, NULL, c->ud, 0); - SvREFCNT_dec(check); - } + SvREFCNT_dec(key); { dMY_CXT; - (void) hv_store(MY_CXT.map, c->name, c->namelen, key, 0); + (void) hv_store(MY_CXT.map, c->name, c->namelen, newSViv(PTR2IV(c)), 0); } } @@ -232,19 +231,18 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { gv = cGVOPx_gv(gvop); { - SV *pp_sv, **svp; - CV *cv = NULL; + SV **svp; + CV *cv = NULL; const char *name = GvNAME(gv); I32 len = GvNAMELEN(gv); + const sub_op_config_t *c; dMY_CXT; svp = hv_fetch(MY_CXT.map, name, len, 0); if (!svp) goto skip; - pp_sv = *svp; - if (!pp_sv || !SvOK(pp_sv)) - goto skip; + c = INT2PTR(const sub_op_config_t *, SvIVX(*svp)); if (gv && SvTYPE(gv) >= SVt_PVGV && (cv = GvCV(gv)) == MY_CXT.placeholder) { SvREFCNT_dec(cv); @@ -252,20 +250,15 @@ STATIC OP *so_ck_entersub(pTHX_ OP *o) { } o->op_type = OP_CUSTOM; - o->op_ppaddr = INT2PTR(Perl_ppaddr_t, SvIVX(pp_sv)); + o->op_ppaddr = c->pp; if (last_arg) last_arg->op_sibling = NULL; op_free(rv2cv); - { - MAGIC *mg = mg_find(pp_sv, PERL_MAGIC_ext); - if (mg) { - sub_op_check_t check = INT2PTR(sub_op_check_t, SvIVX(mg->mg_obj)); - o = CALL_FPTR(check)(aTHX_ o, mg->mg_ptr); - } - } + if (c->check) + o = CALL_FPTR(c->check)(aTHX_ o, c->ud); { so_op_name_t *on = PerlMemShared_malloc(sizeof(*on) + len); diff --git a/lib/Sub/Op.pm b/lib/Sub/Op.pm index 20cc912..44b3e9b 100644 --- a/lib/Sub/Op.pm +++ b/lib/Sub/Op.pm @@ -257,7 +257,7 @@ It will store safe defaults for members you won't set. Registers a name and its configuration into L. The caller is responsible for allocating and freeing the C object. -No pointer to it or to its members is kept. +No pointer to it or to its members is kept, except if you pass the flag C in which case the configuration object will be stolen to be stored into L's internal datastructure. =head2 C diff --git a/sub_op.h b/sub_op.h index 5dbb320..34d5571 100644 --- a/sub_op.h +++ b/sub_op.h @@ -14,6 +14,8 @@ typedef struct { void *ud; } sub_op_config_t; +#define SUB_OP_REGISTER_STEAL 1 + void sub_op_init (sub_op_config_t *c); void sub_op_register(pTHX_ const sub_op_config_t *c, U32 flags); sub_op_config_t *sub_op_dup (pTHX_ const sub_op_config_t *c);