X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouse.xs;h=86b78968b26d9ef4ceae5fd34c14e29af3519f1f;hp=0a7d3f9030ce05e176ef949cc04924a459f70983;hb=6514735e9b5d79f955badf9f50970ee768a44337;hpb=ca8e67d622c1a14bee4933ad64b1e465c5d63766 diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index 0a7d3f9..86b7896 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -1,12 +1,14 @@ #define NEED_newSVpvn_flags_GLOBAL #include "mouse.h" +/* keywords for methods/keys */ SV* mouse_package; SV* mouse_namespace; SV* mouse_methods; SV* mouse_name; SV* mouse_get_attribute; SV* mouse_get_attribute_list; +SV* mouse_coerce; #define MOUSE_xc_flags(a) SvUVX(MOUSE_av_at((a), MOUSE_XC_FLAGS)) #define MOUSE_xc_gen(a) MOUSE_av_at((a), MOUSE_XC_GEN) @@ -366,6 +368,7 @@ BOOT: mouse_namespace = newSVpvs_share("namespace"); mouse_methods = newSVpvs_share("methods"); mouse_name = newSVpvs_share("name"); + mouse_coerce = newSVpvs_share("coerce"); mouse_get_attribute = newSVpvs_share("get_attribute"); mouse_get_attribute_list = newSVpvs_share("get_attribute_list"); @@ -446,6 +449,24 @@ CODE: CV* const code_entity = (CV*)SvRV(code_ref); if(CvANON(code_entity) && CvGV(code_entity) /* a cv under construction has no gv */ ){ + HV* dbsub; + + /* update %DB::sub to make NYTProf happy */ + if((PL_perldb & (PERLDBf_SUBLINE|PERLDB_NAMEANON)) + && PL_DBsub && (dbsub = GvHV(PL_DBsub)) + ){ + /* see Perl_newATTRSUB() in op.c */ + SV* const subname = sv_newmortal(); + HE* orig; + + gv_efullname3(subname, CvGV(code_entity), NULL); + orig = hv_fetch_ent(dbsub, subname, FALSE, 0U); + if(orig){ + gv_efullname3(subname, gv, NULL); + (void)hv_store_ent(dbsub, subname, HeVAL(orig), 0U); + SvREFCNT_inc_simple_void_NN(HeVAL(orig)); + } + } CvGV(code_entity) = gv; CvANON_off(code_entity); @@ -629,6 +650,7 @@ CODE: PUSHMARK(SP); XPUSHs(object); + XPUSHs(boolSV(PL_dirty)); PUTBACK; call_sv(AvARRAY(demolishall)[i], G_VOID | G_EVAL);