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