X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?p=gitmo%2FMouse.git;a=blobdiff_plain;f=xs-src%2FMouse.xs;h=34ba35140a23dd7140daf4b37309ecc6cb10f545;hp=cad8f5a0f135793216864e320f619429fc055e77;hb=40e57f0af7f9fafe8001b59552a5e18e6e205ae6;hpb=31e71b650102441dee8adb661b7ed808b8f4fd93 diff --git a/xs-src/Mouse.xs b/xs-src/Mouse.xs index cad8f5a..34ba351 100644 --- a/xs-src/Mouse.xs +++ b/xs-src/Mouse.xs @@ -449,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);