From: gfx <gfuji@cpan.org>
Date: Tue, 9 Feb 2010 06:12:02 +0000 (+0900)
Subject: Make add_method update %DB::sub for profilers
X-Git-Tag: 0.50_01~15
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=40e57f0af7f9fafe8001b59552a5e18e6e205ae6;p=gitmo%2FMouse.git

Make add_method update %DB::sub for profilers
---

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);