From: Gurusamy Sarathy <gsar@cpan.org>
Date: Sun, 2 Jan 2000 21:58:02 +0000 (+0000)
Subject: make DProf look at $ENV{PERL_DPROF_OUT_FILE_NAME} to make it possible
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=34445a8a84bb43293be0a94405ecd2a0e3baceac;p=p5sagit%2Fp5-mst-13.2.git

make DProf look at $ENV{PERL_DPROF_OUT_FILE_NAME} to make it possible
to write to a file other than tmon.out (suggested by Haakon Alstadheim
<Haakon.Alstadheim@sds.no>)

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

diff --git a/ext/Devel/DProf/DProf.pm b/ext/Devel/DProf/DProf.pm
index 6896929..e9372ff 100644
--- a/ext/Devel/DProf/DProf.pm
+++ b/ext/Devel/DProf/DProf.pm
@@ -133,6 +133,9 @@ C<PERL_DPROF_BUFFER> sets size of output buffer in words.  Defaults to 2**14.
 C<PERL_DPROF_TICKS> sets number of ticks per second on some systems where
 a replacement for times() is used.  Defaults to the value of C<HZ> macro.
 
+C<PERL_DPROF_OUT_FILE_NAME> sets the name of the output file.  If not set,
+defaults to tmon.out.
+
 =head1 BUGS
 
 Builtin functions cannot be measured by Devel::DProf.
diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 6e9cfb3..d59c9df 100644
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -69,6 +69,7 @@ typedef union prof_any PROFANY;
 
 typedef struct {
     U32		dprof_ticks;
+    char*	out_file_name;	/* output file (defaults to tmon.out) */
     PerlIO*	fp;		/* pointer to tmon.out file */
     long	TIMES_LOCATION;	/* Where in the file to store the time totals */
     int		SAVE_STACK;	/* How much data to buffer until end of run */
@@ -105,6 +106,7 @@ typedef struct {
 prof_state_t g_prof_state;
 
 #define g_dprof_ticks		g_prof_state.dprof_ticks
+#define g_out_file_name		g_prof_state.out_file_name
 #define g_fp			g_prof_state.fp
 #define g_TIMES_LOCATION	g_prof_state.TIMES_LOCATION
 #define g_SAVE_STACK		g_prof_state.SAVE_STACK
@@ -663,10 +665,14 @@ BOOT:
 	    else {
 		g_dprof_ticks = HZ;
 	    }
+
+	    buffer = getenv("PERL_DPROF_OUT_FILE_NAME");
+	    g_out_file_name = savepv(buffer ? buffer : "tmon.out");
 	}
 
-        if ((g_fp = PerlIO_open("tmon.out", "w")) == NULL)
-	    croak("DProf: unable to write tmon.out, errno = %d\n", errno);
+        if ((g_fp = PerlIO_open(g_out_file_name, "w")) == NULL)
+	    croak("DProf: unable to write '%s', errno = %d\n",
+		  g_out_file_name, errno);
 
 	g_default_perldb = PERLDBf_NONAME | PERLDBf_SUB | PERLDBf_GOTO;
 	g_cv_hash = newHV();