From: Radu Greab <radu@netsoft.ro>
Date: Sat, 2 Aug 2003 00:17:49 +0000 (+0300)
Subject: Re: [PATCH @19834] DProf fixes
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=19bcb543e1f5bb004bdf7d16ba95ef96ce9e99c8;p=p5sagit%2Fp5-mst-13.2.git

Re: [PATCH @19834] DProf fixes
Message-Id: <20030802.001749.101708736.radu@yx.primIT.ro>

p4raw-id: //depot/perl@20440
---

diff --git a/ext/Devel/DProf/Changes b/ext/Devel/DProf/Changes
index 09b2250..1d1ba0e 100644
--- a/ext/Devel/DProf/Changes
+++ b/ext/Devel/DProf/Changes
@@ -1,3 +1,22 @@
+2003 Aug 1
+ Radu Greab:
+  DProf.xs:
+    - do not assume that $^P stays unchanged inside the profiled subroutine
+  DProf.pm:
+    - increase VERSION
+
+2003 Jul 6
+
+ Radu Greab:
+  DProf.xs:
+    - improved the mapping between subroutines and identifiers
+    - do not assume that $^P stays unchanged during the lifetime of the script
+    - panic when the profiled subroutine is leaved with goto/last/next
+  DProf.pm:
+    - document the problem with the subroutines exited with goto/last/next
+  t/test{7,8}*
+    - added
+
 2003 Jan 8
 
  Blair Zajac:
diff --git a/ext/Devel/DProf/DProf.pm b/ext/Devel/DProf/DProf.pm
index 95fcfc2..1a22b75 100644
--- a/ext/Devel/DProf/DProf.pm
+++ b/ext/Devel/DProf/DProf.pm
@@ -206,7 +206,7 @@ sub DB {
 use XSLoader ();
 
 # Underscore to allow older Perls to access older version from CPAN
-$Devel::DProf::VERSION = '20030108.00_00';  # this version not authorized by
+$Devel::DProf::VERSION = '20030801.00_00';  # this version not authorized by
 				     # Dean Roehrich. See "Changes" file.
 
 XSLoader::load 'Devel::DProf', $Devel::DProf::VERSION;
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 304b56e..4e48910 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -20,7 +20,7 @@ db_get_cv(pTHX_ SV *sv)
 {
 	CV *cv;
 
-	if (PERLDB_SUB_NN) {
+	if (SvIOK(sv)) {			/* if (PERLDB_SUB_NN) { */
 	    cv = INT2PTR(CV*,SvIVX(sv));
 	} else {
 	    if (SvPOK(sv)) {
@@ -315,11 +315,11 @@ prof_dump_until(pTHX_ long ix)
     }
 }
 
-static void
+inline static void
 set_cv_key(pTHX_ CV *cv, char *pname, char *gname)
 {
-	SvGROW(g_key_hash, sizeof(CV*) + strlen(pname) + strlen(gname) + 3);
-	sv_setpvn(g_key_hash, (char*)&cv, sizeof(CV*));
+	SvGROW(g_key_hash, sizeof(CV**) + strlen(pname) + strlen(gname) + 3);
+	sv_setpvn(g_key_hash, (char*)&cv, sizeof(CV**));
 	sv_catpv(g_key_hash, pname);
 	sv_catpv(g_key_hash, "::");
 	sv_catpv(g_key_hash, gname);
diff --git a/t/lib/dprof/test8_t b/t/lib/dprof/test8_t
index 915a7f7..6154c8a 100644
--- a/t/lib/dprof/test8_t
+++ b/t/lib/dprof/test8_t
@@ -2,6 +2,14 @@ sub foo {
 	print "in sub foo\n";
 }
 
+sub bar {
+	print "in sub bar\n";
+	$^P -= 0x40;
+}
+
 foo();
 $^P -= 0x40;
 foo();
+$^P += 0x40;
+bar();
+$^P += 0x40;
diff --git a/t/lib/dprof/test8_v b/t/lib/dprof/test8_v
index a53758b..d5de308 100644
--- a/t/lib/dprof/test8_v
+++ b/t/lib/dprof/test8_v
@@ -5,6 +5,7 @@ use V;
 dprofpp( '-t' );
 $expected = 
 qq{main::foo (2x)
+main::bar
 };
 
 report 20, sub { $expected eq $results };