X-Git-Url: http://git.vpit.fr/?p=perl%2Fmodules%2FLexical-Types.git;a=blobdiff_plain;f=Types.xs;h=2e8bda47037bcbf9f595dc9f0ae72325831138ea;hp=9baa8da22f7f4883d51adfaf13ed83f5fdc8621a;hb=09c7a37f3be8034a8c04c2011208724e04441d83;hpb=dd260203a528f4c8eb219708e2686f9a6fca228f diff --git a/Types.xs b/Types.xs index 9baa8da..2e8bda4 100644 --- a/Types.xs +++ b/Types.xs @@ -121,9 +121,9 @@ STATIC OP *lt_pp_padsv(pTHX) { PUSHMARK(SP); EXTEND(SP, 3); - PUSHs(sv_2mortal(newSVsv(oi->type_pkg))); + PUSHs(oi->type_pkg); PUSHs(sv); - PUSHs(sv_2mortal(newSVsv(oi->orig_pkg))); + PUSHs(oi->orig_pkg); PUTBACK; items = call_sv(oi->type_meth, G_ARRAY | G_METHOD); @@ -160,7 +160,7 @@ STATIC OP *lt_pp_padsv(pTHX) { * pp_padsv, but much less than if we would have set PL_ppaddr[OP_PADSV] * globally. */ -STATIC U32 lt_TYPEDSCALAR_hash = 0; +STATIC SV *lt_default_meth = NULL; STATIC OP *(*lt_old_ck_padany)(pTHX_ OP *) = 0; @@ -175,13 +175,12 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { stash = PL_in_my_stash; if (stash && (hint = lt_hint())) { SV *orig_pkg = newSVpvn(HvNAME_get(stash), HvNAMELEN_get(stash)); - SV *orig_meth = newSVpvn_share("TYPEDSCALAR", 11, lt_TYPEDSCALAR_hash); + SV *orig_meth = lt_default_meth; SV *type_pkg = orig_pkg; SV *type_meth = orig_meth; SV *code = INT2PTR(SV *, SvUVX(hint)); SvREADONLY_on(orig_pkg); - SvREADONLY_on(orig_meth); if (code) { int items; @@ -209,12 +208,16 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { SV *rsv; if (items > 1) { rsv = POPs; - if (SvOK(rsv)) + if (SvOK(rsv)) { type_meth = newSVsv(rsv); + SvREADONLY_on(type_meth); + } } rsv = POPs; - if (SvOK(rsv)) + if (SvOK(rsv)) { type_pkg = newSVsv(rsv); + SvREADONLY_on(type_pkg); + } } PUTBACK; @@ -222,8 +225,11 @@ STATIC OP *lt_ck_padany(pTHX_ OP *o) { LEAVE; } - lt_old_pp_padsv = PL_ppaddr[OP_PADSV]; + if (type_meth == orig_meth) + SvREFCNT_inc(orig_meth); lt_map_store(o, orig_pkg, type_pkg, type_meth, lt_old_pp_padsv); + + lt_old_pp_padsv = PL_ppaddr[OP_PADSV]; PL_ppaddr[OP_PADSV] = lt_pp_padsv; } @@ -249,7 +255,8 @@ PROTOTYPES: DISABLE BOOT: { if (!lt_initialized++) { - PERL_HASH(lt_TYPEDSCALAR_hash, "TYPEDSCALAR", 11); + lt_default_meth = newSVpvn("TYPEDSCALAR", 11); + SvREADONLY_on(lt_default_meth); PERL_HASH(lt_hash, __PACKAGE__, __PACKAGE_LEN__); lt_op_map = newHV();