From: Gurusamy Sarathy <gsar@cpan.org>
Date: Tue, 20 Jul 1999 06:13:16 +0000 (+0000)
Subject: DProf fixups for PERL_IMPLICIT_CONTEXT
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=d7b9cf6367cabfbce13a74b4cf20865766a2274a;p=p5sagit%2Fp5-mst-13.2.git

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
--- 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
--- 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
--- 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	=> {},
 );