DProf fixups for PERL_IMPLICIT_CONTEXT

p4raw-id: //depot/perl@3709

diff --git a/ext/Devel/DProf/DProf.xs b/ext/Devel/DProf/DProf.xs
index 946aee2..1a41c21 100644 (file)
--- a/ext/Devel/DProf/DProf.xs
+++ b/ext/Devel/DProf/DProf.xs
@@ -1,3 +1,5 @@
+/* XXX DProf could use some cleanups for PERL_IMPLICIT_CONTEXT */
+
 #define PERL_POLLUTE
 
 #include "EXTERN.h"
@@ -219,7 +221,7 @@ prof_dump_until(long ix)
 #endif 
        }
     }
-    fflush(fp);
+    PerlIO_flush(fp);
     realtime2 = Times(&t2);
     if (realtime2 != realtime1 || t1.tms_utime != t2.tms_utime
        || t1.tms_stime != t2.tms_stime) {
@@ -235,7 +237,7 @@ prof_dump_until(long ix)
        otms_utime = t2.tms_utime;
        otms_stime = t2.tms_stime;
        orealtime = realtime2;
-       fflush(fp);
+       PerlIO_flush(fp);
     }
 }
 
@@ -243,8 +245,7 @@ static HV* cv_hash;
 static U32 total = 0;
 
 static void
-prof_mark( ptype )
-opcode ptype;
+prof_mark( opcode ptype )
 {
         struct tms t;
         clock_t realtime, rdelta, udelta, sdelta;
@@ -274,7 +275,7 @@ opcode ptype;
            } else { /* Write it to disk now so's not to eat up core */
                if (prof_pid == (int)getpid()) {
                    prof_dumpt(udelta, sdelta, rdelta);
-                   fflush(fp);
+                   PerlIO_flush(fp);
                }
            }
            orealtime = realtime;
@@ -311,7 +312,7 @@ opcode ptype;
                    /* Only record the parent's info */
                    if (prof_pid == (int)getpid()) {
                        prof_dumps(id, pname, gname);
-                       fflush(fp);
+                       PerlIO_flush(fp);
                    } else
                        perldb = 0;             /* Do not debug the kid. */
                }
@@ -401,7 +402,7 @@ opcode ptype;
 #else
                prof_dump(ptype, name);
 #endif 
-                fflush(fp);
+                PerlIO_flush(fp);
             } else
                perldb = 0;             /* Do not debug the kid. */
         }
@@ -481,7 +482,7 @@ prof_recordheader()
                 u, s, r);
         PerlIO_printf(fp, "$over_tests=10000;\n");
 
-        TIMES_LOCATION = ftell(fp);
+        TIMES_LOCATION = PerlIO_tell(fp);
 
         /* Pad with whitespace. */
         /* This should be enough even for very large numbers. */
@@ -490,7 +491,7 @@ prof_recordheader()
         PerlIO_printf(fp, "\n");
         PerlIO_printf(fp, "PART2\n" );
 
-        fflush(fp);
+        PerlIO_flush(fp);
 }
 
 static void
@@ -506,7 +507,7 @@ prof_record()
         if(SAVE_STACK){
            prof_dump_until(profstack_ix);
         }
-        fseek(fp, TIMES_LOCATION, SEEK_SET);
+        PerlIO_seek(fp, TIMES_LOCATION, SEEK_SET);
        /* Write into reserved 240 bytes: */
         PerlIO_printf(fp, "$rrun_utime=%ld; $rrun_stime=%ld; $rrun_rtime=%ld;",
                 prof_end.tms_utime - prof_start.tms_utime - wprof_u,
@@ -514,7 +515,7 @@ prof_record()
                 rprof_end - rprof_start - wprof_r );
         PerlIO_printf(fp, "\n$total_marks=%ld;", total);
        
-        fclose( fp );
+        PerlIO_close( fp );
 }
 
 #define NONESUCH()
@@ -522,7 +523,7 @@ prof_record()
 static U32 depth = 0;
 
 static void
-check_depth(void *foo)
+check_depth(pTHX_ void *foo)
 {
     U32 need_depth = (U32)foo;
     if (need_depth != depth) {
@@ -677,7 +678,7 @@ BOOT:
            }
        }
 
-        if( (fp = fopen( "tmon.out", "w" )) == NULL )
+        if( (fp = PerlIO_open( "tmon.out", "w" )) == NULL )
                 croak("DProf: unable to write tmon.out, errno = %d\n", errno );
 #ifdef PERLDBf_NONAME
        default_perldb = PERLDBf_NONAME | PERLDBf_SUB; /* no name needed. */

diff --git a/ext/Devel/DProf/Makefile.PL b/ext/Devel/DProf/Makefile.PL
index ec23edb..6de38f7 100644 (file)
--- a/ext/Devel/DProf/Makefile.PL
+++ b/ext/Devel/DProf/Makefile.PL
@@ -1,34 +1,21 @@
 use ExtUtils::MakeMaker;
-require 5.003;
-die qq{
 
-Your perl is too old for this version of DProf. The last version of
-DProf that works for perls older than 5.004 is DProf-19960930 and
-should be available from Dean Roehrich\'s directory on CPAN:
-
-    CPAN/authors/id/DMR/
-
-Please either upgrade your perl or get that older DProf from CPAN.
-
-} if $] < 5.004;
-
-if ($] < 5.005) {
-  $defines = '';
-} else {
-  $defines = '-DPERLDBf_NONAME=0x40 -DPERLDBf_GOTO=0x80 -DG_NODEBUG=32 -DPL_NEEDED';
-}
-
-$Verbose = 1;
 WriteMakefile(
-       'NAME'          => 'Devel::DProf',
-       'DISTNAME'      => 'DProf',
-       'VERSION_FROM'  => 'DProf.pm',
-       'clean'         => {'FILES' => 'tmon.out t/tmon.out t/err dprofpp T/tmon.out'},
-       'EXE_FILES'     => ['dprofpp'],
-       'PL_FILES'      => {'dprofpp.PL' => 'dprofpp'},
-       'XSPROTOARG'    => '-noprototypes',
-       'DEFINE'        => $defines,
-       'dist' => { COMPRESS => 'gzip', SUFFIX => 'gz' },
+       NAME            => 'Devel::DProf',
+       DISTNAME        => 'DProf',
+       VERSION_FROM    => 'DProf.pm',
+       clean           => { 'FILES' => 'tmon.out t/tmon.out t/err dprofpp T/tmon.out'},
+       EXE_FILES       => ['dprofpp'],
+       PL_FILES        => {'dprofpp.PL' => 'dprofpp'},
+       XSPROTOARG      => '-noprototypes',
+       DEFINE          => '-DPERLDBf_NONAME=0x40 -DPERLDBf_GOTO=0x80 '
+                         .'-DG_NODEBUG=32 -DPL_NEEDED',
+       dist            => {
+                            COMPRESS => 'gzip -9f',
+                            SUFFIX => 'gz',
+                            DIST_DEFAULT => 'all tardist',
+                          },
+       MAN3PODS        => {},
 );
 
 sub MY::test_via_harness { "" }

diff --git a/ext/Devel/Peek/Makefile.PL b/ext/Devel/Peek/Makefile.PL
index 3563ef2..3c6dbf5 100644 (file)
--- a/ext/Devel/Peek/Makefile.PL
+++ b/ext/Devel/Peek/Makefile.PL
@@ -7,5 +7,5 @@ WriteMakefile(
                             SUFFIX     => 'gz',
                             DIST_DEFAULT => 'all tardist',
                           },
-       MAN3PODS        => ' ',
+       MAN3PODS        => {},
 );