move DProf things around to where they are supposed to be

p4raw-id: //depot/perl@3710

17 files changed, 1 insertions, 1294 deletions

diff --git a/ext/Devel/DProf/Makefile.PL b/ext/Devel/DProf/Makefile.PL
index 6de38f7ad0..667cc52913 100644
--- a/ext/Devel/DProf/Makefile.PL
+++ b/ext/Devel/DProf/Makefile.PL
@@ -4,9 +4,7 @@ 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'},
+	clean		=> { 'FILES' => 'tmon.out t/tmon.out t/err'},
 	XSPROTOARG	=> '-noprototypes',
 	DEFINE		=> '-DPERLDBf_NONAME=0x40 -DPERLDBf_GOTO=0x80 '
 			  .'-DG_NODEBUG=32 -DPL_NEEDED',
@@ -17,26 +15,3 @@ WriteMakefile(
 			   },
 	MAN3PODS	=> {},
 );
-
-sub MY::test_via_harness { "" }
-#sub MY::test_via_harness {
-#	my( $self, $perl, $tests ) = @_;
-#	my $t = quotemeta( $tests );
-#	my $res;
-#
-#	$res = $self->MM::test_via_harness( $perl, $tests );
-#	$res =~ s/^(\s+)/$1-/;
-#	$res =~ s/(&runtests)/\$\$switches $1/;
-#	$res =~ s/(; runtests)/; \$\$switches=q{-d:DProf}$1/;
-#	$res =~ s,$t,t/bug.t,;
-#	$res;
-#}
-
-sub MY::test_via_script {
-	my( $self, $perl, $script ) = @_;
-	my $res;
-
-	$res = $self->MM::test_via_script( $perl, $script );
-	$res =~ s/(test.pl)/$1 -p $perl/;
-	$res;
-}
diff --git a/ext/Devel/DProf/dprofpp.PL b/ext/Devel/DProf/dprofpp.PL
deleted file mode 100644
index c5130629f4..0000000000
--- a/ext/Devel/DProf/dprofpp.PL
+++ /dev/null
@@ -1,800 +0,0 @@
-#!/usr/local/bin/perl
-
-use Config;
-use File::Basename qw(&basename &dirname);
-
-# List explicitly here the variables you want Configure to
-# generate.  Metaconfig only looks for shell variables, so you
-# have to mention them as if they were shell variables, not
-# %Config entries.  Thus you write
-#  $startperl
-# to ensure Configure will look for $Config{startperl}.
-
-# This forces PL files to create target in same directory as PL file.
-# This is so that make depend always knows where to find PL derivatives.
-chdir(dirname($0));
-($file = basename($0)) =~ s/\.PL$//;
-$file =~ s/\.pl$//
-	if ($Config{'osname'} eq 'VMS' or
-	    $Config{'osname'} eq 'OS2');  # "case-forgiving"
-
-print "Pulling version from Makefile for dprofpp...\n";
-my $VERSION = 0;
-open( MK, "<Makefile" ) || die "Can't open Makefile: $!";
-while(<MK>){
-	if( /^VERSION\s*=\s*(\d+)/ ){
-		$VERSION = $1;
-		last;
-	}
-}
-close MK;
-if( $VERSION == 0 ){
-	die "Did not find VERSION in Makefile";
-}
-print "   version is ($VERSION).\n";
-
-open OUT,">$file" or die "Can't create $file: $!";
-
-print "Extracting $file (with variable substitutions)\n";
-
-# In this section, perl variables will be expanded during extraction.
-# You can use $Config{...} to use Configure variables.
-
-print OUT <<"!GROK!THIS!";
-$Config{'startperl'}
-    eval 'exec perl -S \$0 "\$@"'
-	if 0;
-
-require 5.003;
-
-my \$VERSION = $VERSION;
-
-!GROK!THIS!
-
-# In the following, perl variables are not expanded during extraction.
-
-print OUT <<'!NO!SUBS!';
-=head1 NAME
-
-dprofpp - display perl profile data
-
-=head1 SYNOPSIS
-
-dprofpp [B<-a>|B<-z>|B<-l>|B<-v>|B<-U>] [B<-s>|B<-r>|B<-u>] [B<-q>] [B<-F>] [B<-I|-E>] [B<-O cnt>] [B<-A>] [B<-R>] [B<-S>] [B<-g subroutine>] [profile]
-
-dprofpp B<-T> [B<-F>] [B<-g subroutine>] [profile]
-
-dprofpp B<-t> [B<-F>] [B<-g subroutine>] [profile]
-
-dprofpp B<-p script> [B<-Q>] [other opts]
-
-dprofpp B<-V> [profile]
-
-=head1 DESCRIPTION
-
-The I<dprofpp> command interprets profile data produced by a profiler, such
-as the Devel::DProf profiler.  Dprofpp will read the file F<tmon.out> and
-will display the 15 subroutines which are using the most time.  By default
-the times for each subroutine are given exclusive of the times of their
-child subroutines.
-
-To profile a Perl script run the perl interpreter with the B<-d> switch.  So
-to profile script F<test.pl> with Devel::DProf the following command should
-be used.
-
-	$ perl5 -d:DProf test.pl
-
-Then run dprofpp to analyze the profile.
-
-	$ dprofpp -u
-	Total Elapsed Time =    1.67 Seconds
-		 User Time =    0.61 Seconds
-	Exclusive Times
-	%Time Seconds     #Calls sec/call Name
-	 52.4   0.320          2   0.1600 main::foo
-	 45.9   0.280        200   0.0014 main::bar
-	 0.00   0.000          1   0.0000 DynaLoader::import
-	 0.00   0.000          1   0.0000 main::baz
-
-The dprofpp tool can also run the profiler before analyzing the profile
-data.  The above two commands can be executed with one dprofpp command.
-
-	$ dprofpp -u -p test.pl
-
-Consult L<Devel::DProf/"PROFILE FORMAT"> for a description of the raw profile.
-
-=head1 OPTIONS
-
-=over 5
-
-=item B<-a>
-
-Sort alphabetically by subroutine names.
-
-=item B<-A>
-
-Count timing for autoloaded subroutine as timing for C<*::AUTOLOAD>.
-Otherwise the time to autoload it is counted as time of the subroutine
-itself (there is no way to separate autoload time from run time).
-
-This is going to be irrelevant with newer Perls.  They will inform
-C<Devel::DProf> I<when> the C<AUTOLOAD> switches to actual subroutine,
-so a separate statistics for C<AUTOLOAD> will be collected no matter
-whether this option is set.
-
-=item B<-R>
-
-Count anonymous subroutines defined in the same package separately.
-
-=item B<-E>
-
-(default)  Display all subroutine times exclusive of child subroutine times.
-
-=item B<-F>
-
-Force the generation of fake exit timestamps if dprofpp reports that the
-profile is garbled.  This is only useful if dprofpp determines that the
-profile is garbled due to missing exit timestamps.  You're on your own if
-you do this.  Consult the BUGS section.
-
-=item B<-I>
-
-Display all subroutine times inclusive of child subroutine times.
-
-=item B<-l>
-
-Sort by number of calls to the subroutines.  This may help identify
-candidates for inlining.
-
-=item B<-O cnt>
-
-Show only I<cnt> subroutines.  The default is 15.
-
-=item B<-p script>
-
-Tells dprofpp that it should profile the given script and then interpret its
-profile data.  See B<-Q>.
-
-=item B<-Q>
-
-Used with B<-p> to tell dprofpp to quit after profiling the script, without
-interpreting the data.
-
-=item B<-q>
-
-Do not display column headers.
-
-=item B<-r>
-
-Display elapsed real times rather than user+system times.
-
-=item B<-s>
-
-Display system times rather than user+system times.
-
-=item B<-T>
-
-Display subroutine call tree to stdout.  Subroutine statistics are
-not displayed.
-
-=item B<-t>
-
-Display subroutine call tree to stdout.  Subroutine statistics are not
-displayed.  When a function is called multiple consecutive times at the same
-calling level then it is displayed once with a repeat count.
-
-=item B<-S>
-
-Display I<merged> subroutine call tree to stdout.  Statistics is
-displayed for each branch of the tree.  
-
-When a function is called multiple (I<not necessarily consecutive>)
-times in the same branch then all these calls go into one branch of
-the next level.  A repeat count is output together with combined
-inclusive, exclusive and kids time.
-
-Branches are sorted w.r.t. inclusive time.
-
-=item B<-U>
-
-Do not sort.  Display in the order found in the raw profile.
-
-=item B<-u>
-
-Display user times rather than user+system times.
-
-=item B<-V>
-
-Print dprofpp's version number and exit.  If a raw profile is found then its
-XS_VERSION variable will be displayed, too.
-
-=item B<-v>
-
-Sort by average time spent in subroutines during each call.  This may help
-identify candidates for inlining. 
-
-=item B<-z>
-
-(default) Sort by amount of user+system time used.  The first few lines
-should show you which subroutines are using the most time.
-
-=item B<-g> C<subroutine>
-
-Ignore subroutines except C<subroutine> and whatever is called from it.
-
-=back
-
-=head1 ENVIRONMENT
-
-The environment variable B<DPROFPP_OPTS> can be set to a string containing
-options for dprofpp.  You might use this if you prefer B<-I> over B<-E> or
-if you want B<-F> on all the time.
-
-This was added fairly lazily, so there are some undesirable side effects.
-Options on the commandline should override options in DPROFPP_OPTS--but
-don't count on that in this version.
-
-=head1 BUGS
-
-Applications which call _exit() or exec() from within a subroutine
-will leave an incomplete profile.  See the B<-F> option.
-
-Any bugs in Devel::DProf, or any profiler generating the profile data, could
-be visible here.  See L<Devel::DProf/BUGS>.
-
-Mail bug reports and feature requests to the perl5-porters mailing list at
-F<E<lt>perl5-porters@perl.orgE<gt>>.  Bug reports should include the
-output of the B<-V> option.
-
-=head1 FILES
-
-	dprofpp		- profile processor
-	tmon.out	- raw profile
-
-=head1 SEE ALSO
-
-L<perl>, L<Devel::DProf>, times(2)
-
-=cut
-
-use Getopt::Std 'getopts';
-use Config '%Config';
-
-Setup: {
-	my $options = 'O:g:lzaAvuTtqrRsUFEIp:QVS';
-
-	$Monfile = 'tmon.out';
-	if( exists $ENV{DPROFPP_OPTS} ){
-		my @tmpargv = @ARGV;
-		@ARGV = split( ' ', $ENV{DPROFPP_OPTS} );
-		getopts( $options );
-		if( @ARGV ){
-			# there was a filename.
-			$Monfile = shift;
-		}
-		@ARGV = @tmpargv;
-	}
-
-	getopts( $options );
-	if( @ARGV ){
-		# there was a filename, it overrides any earlier name.
-		$Monfile = shift;
-	}
-
-# -O cnt	Specifies maximum number of subroutines to display.
-# -a		Sort by alphabetic name of subroutines.
-# -z		Sort by user+system time spent in subroutines. (default)
-# -l		Sort by number of calls to subroutines.
-# -v		Sort by average amount of time spent in subroutines.
-# -T		Show call tree.
-# -t		Show call tree, compressed.
-# -q		Do not print column headers.
-# -u		Use user time rather than user+system time.
-# -s		Use system time rather than user+system time.
-# -r		Use real elapsed time rather than user+system time.
-# -U		Do not sort subroutines.
-# -E		Sub times are reported exclusive of child times. (default)
-# -I		Sub times are reported inclusive of child times.
-# -V		Print dprofpp's version.
-# -p script	Specifies name of script to be profiled.
-# -Q		Used with -p to indicate the dprofpp should quit after
-#		profiling the script, without interpreting the data.
-# -A		count autoloaded to *AUTOLOAD
-# -R		count anonyms separately even if from the same package
-# -g subr	count only those who are SUBR or called from SUBR
-# -S		Create statistics for all the depths
-
-	if( defined $opt_V ){
-		my $fh = 'main::fh';
-		print "$0 version: $VERSION\n";
-		open( $fh, "<$Monfile" ) && do {
-			local $XS_VERSION = 'early';
-			header($fh);
-			close( $fh );
-			print "XS_VERSION: $XS_VERSION\n";
-		};
-		exit(0);
-	}
-	$cnt = $opt_O || 15;
-	$sort = 'by_time';
-	$sort = 'by_ctime' if defined $opt_I;
-	$sort = 'by_calls' if defined $opt_l;
-	$sort = 'by_alpha' if defined $opt_a;
-	$sort = 'by_avgcpu' if defined $opt_v;
-	$incl_excl = 'Exclusive';
-	$incl_excl = 'Inclusive' if defined $opt_I;
-	$whichtime = 'User+System';
-	$whichtime = 'System' if defined $opt_s;
-	$whichtime = 'Real' if defined $opt_r;
-	$whichtime = 'User' if defined $opt_u;
-
-	if( defined $opt_p ){
-		my $prof = 'DProf';
-		my $startperl = $Config{'startperl'};
-
-		$startperl =~ s/^#!//; # remove shebang
-		run_profiler( $opt_p, $prof, $startperl );
-		$Monfile = 'tmon.out';  # because that's where it is
-		exit(0) if defined $opt_Q;
-	}
-	elsif( defined $opt_Q ){
-		die "-Q is meaningful only when used with -p\n";
-	}
-}
-
-Main: {
-	my $monout = $Monfile;
-	my $fh = 'main::fh';
-	local $names = {};
-	local $times = {};   # times in hz
-	local $ctimes = {};  # Cumulative times in hz
-	local $calls = {};
-	local $persecs = {}; # times in seconds
-	local $idkeys = [];
-	local $runtime; # runtime in seconds
-	my @a = ();
-	my $a;
-	local $rrun_utime = 0;	# user time in hz
-	local $rrun_stime = 0;	# system time in hz
-	local $rrun_rtime = 0;	# elapsed run time in hz
-	local $rrun_ustime = 0;	# user+system time in hz
-	local $hz = 0;
-	local $deep_times = {count => 0 , kids => {}, incl_time => 0};
-	local $time_precision = 2;
-	local $overhead = 0;
-
-	open( $fh, "<$monout" ) || die "Unable to open $monout\n";
-
-	header($fh);
-
-	$rrun_ustime = $rrun_utime + $rrun_stime;
-
-	$~ = 'STAT';
-	if( ! $opt_q ){
-		$^ = 'CSTAT_top';
-	}
-
-	parsestack( $fh, $names, $calls, $times, $ctimes, $idkeys );
-
-	settime( \$runtime, $hz ) unless $opt_g;
-
-	exit(0) if $opt_T || $opt_t;
-
-	if( $opt_v ){
-		percalc( $calls, ($opt_I ? $ctimes : $times), $persecs, $idkeys );
-	}
-	if( ! $opt_U ){
-		@a = sort $sort @$idkeys;
-		$a = \@a;
-	}
-	else {
-		$a = $idkeys;
-	}
-	display( $runtime, $hz, $names, $calls, $times, $ctimes, $cnt, $a,
-		 $deep_times);
-}
-
-
-# Sets $runtime to user, system, real, or user+system time.  The
-# result is given in seconds.
-#
-sub settime {
-  my( $runtime, $hz ) = @_;
-  
-  if( $opt_r ){
-    $$runtime = ($rrun_rtime - $overhead - $over_rtime * $total_marks/$over_tests/2)/$hz;
-  }
-  elsif( $opt_s ){
-    $$runtime = ($rrun_stime - $overhead - $over_stime * $total_marks/$over_tests/2)/$hz;
-  }
-  elsif( $opt_u ){
-    $$runtime = ($rrun_utime - $overhead - $over_utime * $total_marks/$over_tests/2)/$hz;
-  }
-  else{
-    $$runtime = ($rrun_ustime - $overhead - ($over_utime + $over_stime) * $total_marks/$over_tests/2)/$hz;
-  }
-  $$runtime = 0 unless $$runtime > 0;
-}
-
-sub exclusives_in_tree {
-  my( $deep_times ) = @_;
-  my $kids_time = 0;
-  my $kid;
-  # When summing, take into account non-rounded-up kids time.
-  for $kid (keys %{$deep_times->{kids}}) {
-    $kids_time += $deep_times->{kids}{$kid}{incl_time};
-  }
-  $kids_time = 0 unless $kids_time >= 0;
-  $deep_times->{excl_time} = $deep_times->{incl_time} - $kids_time;
-  $deep_times->{excl_time} = 0 unless $deep_times->{excl_time} >= 0;
-  for $kid (keys %{$deep_times->{kids}}) {
-    exclusives_in_tree($deep_times->{kids}{$kid});
-  }
-  $deep_times->{incl_time} = 0 unless $deep_times->{incl_time} >= 0;
-  $deep_times->{kids_time} = $kids_time;
-}
-
-sub kids_by_incl { $kids{$b}{incl_time} <=> $kids{$a}{excl_time} 
-		   or $a cmp $b }
-
-sub display_tree {
-  my( $deep_times, $name, $level ) = @_;
-  exclusives_in_tree($deep_times);
-  
-  my $kid;
-  local *kids = $deep_times->{kids}; # %kids
-
-  my $time;
-  if (%kids) {
-    $time = sprintf '%.*fs = (%.*f + %.*f)', 
-      $time_precision, $deep_times->{incl_time}/$hz,
-        $time_precision, $deep_times->{excl_time}/$hz,
-          $time_precision, $deep_times->{kids_time}/$hz;
-  } else {
-    $time = sprintf '%.*f', $time_precision, $deep_times->{incl_time}/$hz;
-  }
-  print ' ' x (2*$level), "$name x $deep_times->{count}  \t${time}s\n"
-    if $deep_times->{count};
-
-  for $kid (sort kids_by_incl keys %kids) {
-    display_tree( $deep_times->{kids}{$kid}, $kid, $level + 1 );
-  }  
-}
-
-# Report the times in seconds.
-sub display {
-	my( $runtime, $hz, $names, $calls, $times, $ctimes, $cnt, 
-	    $idkeys, $deep_times ) = @_;
-	my( $x, $key, $s, $cs );
-	#format: $ncalls, $name, $secs, $percall, $pcnt
-
-	if ($opt_S) {
-	  display_tree( $deep_times, 'toplevel', -1 )
-	} else {
-	  for( $x = 0; $x < @$idkeys; ++$x ){
-	    $key = $idkeys->[$x];
-	    $ncalls = $calls->{$key};
-	    $name = $names->{$key};
-	    $s = $times->{$key}/$hz;
-	    $secs = sprintf("%.3f", $s );
-	    $cs = $ctimes->{$key}/$hz;
-	    $csecs = sprintf("%.3f", $cs );
-	    $percall = sprintf("%.4f", $s/$ncalls );
-	    $cpercall = sprintf("%.4f", $cs/$ncalls );
-	    $pcnt = sprintf("%.2f",
-			    $runtime? ((($opt_I ? $csecs : $secs) / $runtime) * 100.0): 0 );
-	    write;
-	    $pcnt = $secs = $ncalls = $percall = "";
-	    write while( length $name );
-	    last unless --$cnt;
-	  }	  
-	}
-}
-
-sub move_keys {
-  my ($source, $dest) = @_;
-  my $kid;
-  
-  for $kid (keys %$source) {
-    if (exists $dest->{$kid}) {
-      $dest->{count} += $source->{count};
-      $dest->{incl_time} += $source->{incl_time};
-      move_keys($source->{kids},$dest->{kids});
-    } else {
-      $dest->{$kid} = delete $source->{$kid};
-    }
-  }
-}
-
-sub add_to_tree {
-  my ($curdeep_times, $name, $t) = @_;
-  if ($name ne $curdeep_times->[-1]{name} and $opt_A) {
-    $name = $curdeep_times->[-1]{name};
-  }
-  die "Shorted?!" unless @$curdeep_times >= 2;
-  $curdeep_times->[-2]{kids}{$name} = { count => 0 , kids => {}, 
-					incl_time => 0,
-				      } 
-    unless exists $curdeep_times->[-2]{kids}{$name};
-  my $entry = $curdeep_times->[-2]{kids}{$name};
-  # Now transfer to the new node (could not do earlier, since name can change)
-  $entry->{count}++;
-  $entry->{incl_time} += $t - $curdeep_times->[-1]{enter_stamp};
-  # Merge the kids?
-  move_keys($curdeep_times->[-1]->{kids},$entry->{kids});
-  pop @$curdeep_times;
-}
-
-sub parsestack {
-	my( $fh, $names, $calls, $times, $ctimes, $idkeys ) = @_;
-	my( $dir, $name );
-	my( $t, $syst, $realt, $usert );
-	my( $x, $z, $c, $id, $pack );
-	my @stack = ();
-	my @tstack = ();
-	my $tab = 3;
-	my $in = 0;
-
-	# remember last call depth and function name
-	my $l_in = $in;
-	my $l_name = '';
-	my $repcnt = 0;
-	my $repstr = '';
-	my $dprof_t = 0;
-	my $dprof_stamp;
-	my %cv_hash;
-	my $in_level = not defined $opt_g; # Level deep in report grouping
-	my $curdeep_times = [$deep_times];
-
-	my $over_per_call;
-	if   ( $opt_u )	{	$over_per_call = $over_utime		}
-	elsif( $opt_s )	{	$over_per_call = $over_stime		}
-	elsif( $opt_r )	{	$over_per_call = $over_rtime		}
-	else		{	$over_per_call = $over_utime + $over_stime }
-	$over_per_call /= 2*$over_tests; # distribute over entry and exit
-
-	while(<$fh>){
-		next if /^#/;
-		last if /^PART/;
-
-		chop;
-		if (/^&/) {
-		  ($dir, $id, $pack, $name) = split;
-		  if ($opt_R and ($name =~ /::(__ANON_|END)$/)) {
-		    $name .= "($id)";
-		  }
-		  $cv_hash{$id} = "$pack\::$name";
-		  next;
-		}
-		($dir, $usert, $syst, $realt, $name) = split;
-
-		my $ot = $t;
-		if ( $dir eq '/' ) {
-		  $syst = $stack[-1][0];
-		  $usert = '&';
-		  $dir = '-';
-		  #warn("Inserted exit for $stack[-1][0].\n")
-		}
-		if (defined $realt) { # '+ times nam' '- times nam' or '@ incr'
-		  if   ( $opt_u )	{	$t = $usert		}
-		  elsif( $opt_s )	{	$t = $syst		}
-		  elsif( $opt_r )	{	$t = $realt		}
-		  else			{	$t = $usert + $syst	}
-		  $t += $ot, next if $dir eq '@'; # Increments there
-		} else {
-		  # "- id" or "- & name"
-		  $name = defined $syst ? $syst : $cv_hash{$usert};
-		}
-
-		next unless $in_level or $name eq $opt_g or $dir eq '*';
-		if ( $dir eq '-' or $dir eq '*' ) {
-		  	my $ename = $dir eq '*' ? $stack[-1][0]  : $name;
-			$overhead += $over_per_call;
-		  	if ($name eq "Devel::DProf::write") {
-			  $dprof_t += $t - $dprof_stamp;
-			  next;
-		  	} elsif (defined $opt_g and $ename eq $opt_g) {
-			  $in_level--;
-			}
-			add_to_tree($curdeep_times, $ename,
-				    $t - $dprof_t - $overhead) if $opt_S;
-			exitstamp( \@stack, \@tstack, 
-				   $t - $dprof_t - $overhead, 
-				   $times, $ctimes, $ename, \$in, $tab, 
-				   $curdeep_times );
-		} 
-		next unless $in_level or $name eq $opt_g;
-		if( $dir eq '+' or $dir eq '*' ){
-		  	if ($name eq "Devel::DProf::write") {
-			  $dprof_stamp = $t;
-			  next;
-		  	} elsif (defined $opt_g and $name eq $opt_g) {
-			  $in_level++;
-		  	}
-			$overhead += $over_per_call;
-			if( $opt_T ){
-				print ' ' x $in, "$name\n";
-				$in += $tab;
-			}
-			elsif( $opt_t ){
-				# suppress output on same function if the
-				# same calling level is called.
-				if ($l_in == $in and $l_name eq $name) {
-					$repcnt++;
-				} else {
-					$repstr = ' ('.++$repcnt.'x)'
-						 if $repcnt;
-					print ' ' x $l_in, "$l_name$repstr\n"
-						if $l_name ne '';
-					$repstr = '';
-					$repcnt = 0;
-					$l_in = $in;
-					$l_name = $name;
-				}
-				$in += $tab;
-			}
-			if( ! defined $names->{$name} ){
-				$names->{$name} = $name;
-				$times->{$name} = 0;
-				$ctimes->{$name} = 0;
-				push( @$idkeys, $name );
-			}
-			$calls->{$name}++;
-			push @$curdeep_times, { kids => {}, 
-						name => $name, 
-						enter_stamp => $t - $dprof_t - $overhead,
-					      } if $opt_S;
-			$x = [ $name, $t - $dprof_t - $overhead ];
-			push( @stack, $x );
-
-			# my children will put their time here
-			push( @tstack, 0 );
-		} elsif ($dir ne '-'){
-		    die "Bad profile: $_";
-	        }
-	}
-	if( $opt_t ){
-		$repstr = ' ('.++$repcnt.'x)' if $repcnt;
-		print ' ' x $l_in, "$l_name$repstr\n";
-	}
-
-	if( @stack ){
-		if( ! $opt_F ){
-			warn "Garbled profile is missing some exit time stamps:\n";
-			foreach $x (@stack) {
-				print $x->[0],"\n";
-			}
-			die "Try rerunning dprofpp with -F.\n";
-			# I don't want -F to be default behavior--yet
-			#  9/18/95 dmr
-		}
-		else{
-			warn( "Faking " . scalar( @stack ) . " exit timestamp(s).\n");
-			foreach $x ( reverse @stack ){
-				$name = $x->[0];
-				exitstamp( \@stack, \@tstack, 
-					   $t - $dprof_t - $overhead, $times, 
-					   $ctimes, $name, \$in, $tab, 
-					   $curdeep_times );
-				add_to_tree($curdeep_times, $name,
-					    $t - $dprof_t - $overhead)
-				  if $opt_S;
-			}
-		}
-	}
-	if (defined $opt_g) {
-	  $runtime = $ctimes->{$opt_g}/$hz;
-	  $runtime = 0 unless $runtime > 0;
-	}
-}
-
-sub exitstamp {
-	my($stack, $tstack, $t, $times, $ctimes, $name, $in, $tab, $deep) = @_;
-	my( $x, $c, $z );
-
-	$x = pop( @$stack );
-	if( ! defined $x ){
-		die "Garbled profile, missing an enter time stamp";
-	}
-	if( $x->[0] ne $name ){
-	  if ($x->[0] =~ /::AUTOLOAD$/) {
-	    if ($opt_A) {
-	      $name = $x->[0];
-	    }
-	  } elsif ( $opt_F ) {
-	    warn( "Garbled profile, faking exit timestamp:\n\t$name => $x->[0].\n");
-	    $name = $x->[0];
-	  } else {
-	    foreach $z (@stack, $x) {
-	      print $z->[0],"\n";
-	    }
-	    die "Garbled profile, unexpected exit time stamp";
-	  }
-	}
-	if( $opt_T || $opt_t ){
-		$$in -= $tab;
-	}
-	# collect childtime
-	$c = pop( @$tstack );
-	# total time this func has been active
-	$z = $t - $x->[1];
-	$ctimes->{$name} += $z;
-	$times->{$name} += ($z > $c)? $z - $c: 0;
-	# pass my time to my parent
-	if( @$tstack ){
-		$c = pop( @$tstack );
-		push( @$tstack, $c + $z );
-	}
-}
-
-
-sub header {
-	my $fh = shift;
-	chop($_ = <$fh>);
-	if( ! /^#fOrTyTwO$/ ){
-		die "Not a perl profile";
-	}
-	while(<$fh>){
-		next if /^#/;
-		last if /^PART/;
-		eval;
-	}
-	$over_tests = 1 unless $over_tests;
-	$time_precision = length int ($hz - 1);	# log ;-)
-}
-
-
-# Report avg time-per-function in seconds
-sub percalc {
-	my( $calls, $times, $persecs, $idkeys ) = @_;
-	my( $x, $t, $n, $key );
-
-	for( $x = 0; $x < @$idkeys; ++$x ){
-		$key = $idkeys->[$x];
-		$n = $calls->{$key};
-		$t = $times->{$key} / $hz;
-		$persecs->{$key} = $t ? $t / $n : 0;
-	}
-}
-
-
-# Runs the given script with the given profiler and the given perl.
-sub run_profiler {
-	my $script = shift;
-	my $profiler = shift;
-	my $startperl = shift;
-
-	system $startperl, "-d:$profiler", $script;
-	if( $? / 256 > 0 ){
-		die "Failed: $startperl -d:$profiler $script: $!";
-	}
-}
-
-
-sub by_time { $times->{$b} <=> $times->{$a} }
-sub by_ctime { $ctimes->{$b} <=> $ctimes->{$a} }
-sub by_calls { $calls->{$b} <=> $calls->{$a} }
-sub by_alpha { $names->{$a} cmp $names->{$b} }
-sub by_avgcpu { $persecs->{$b} <=> $persecs->{$a} }
-
-
-format CSTAT_top =
-Total Elapsed Time = @>>>>>>> Seconds
-(($rrun_rtime - $overhead - $over_rtime * $total_marks/$over_tests/2) / $hz)
-  @>>>>>>>>>> Time = @>>>>>>> Seconds
-$whichtime, $runtime
-@<<<<<<<< Times
-$incl_excl
-%Time ExclSec CumulS #Calls sec/call Csec/c  Name
-.
-
-format STAT =
- ^>>>   ^>>>> ^>>>>> ^>>>>>   ^>>>>> ^>>>>>  ^<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<
-$pcnt, $secs, $csecs, $ncalls, $percall, $cpercall, $name
-.
-
-!NO!SUBS!
-
-close OUT or die "Can't close $file: $!";
-chmod 0755, $file or die "Can't reset permissions for $file: $!\n";
-exec("$Config{'eunicefix'} $file") if $Config{'eunicefix'} ne ':';
diff --git a/ext/Devel/DProf/t/V.pm b/ext/Devel/DProf/t/V.pm
deleted file mode 100644
index e8d59a8129..0000000000
--- a/ext/Devel/DProf/t/V.pm
+++ /dev/null
@@ -1,65 +0,0 @@
-package V;
-
-use Getopt::Std 'getopts';
-getopts('vp:');
-
-require Exporter;
-@ISA = 'Exporter';
-
-@EXPORT = qw( dprofpp $opt_v $results $expected report @results );
-@EXPORT_OK = qw( notok ok $num );
-
-my $out = 0;
-$num = 0;
-$results = $expected = '';
-$perl = $opt_p || $^X;
-
-print "\nperl: $perl\n" if $opt_v;
-if( ! -f $perl ){ die "Where's Perl?" }
-
-sub dprofpp {
-	my $switches = shift;
-
-	open( D, "$perl ../dprofpp $switches 2> err |" ) || warn "$0: Can't run. $!\n";
-	@results = <D>;
-	close D;
-
-	open( D, "<err" ) || warn "$0: Can't open: $!\n";
-	@err = <D>;
-	close D;
-	push( @results, @err ) if @err;
-
-	$results = qq{@results};
-	# ignore Loader (Dyna/Auto etc), leave newline
-	$results =~ s/^\w+Loader::import//;
-	$results =~ s/\n /\n/gm;
-	$results;
-}
-
-sub report {
-	$num = shift;
-	my $sub = shift;
-	my $x;
-
-	$x = &$sub;
-	$x ? &ok : &notok;
-}
-
-sub ok {
-	++$out;
-	print "ok $num, ";
-}
-
-sub notok {
-	++$out;
-	print "not ok $num, ";
-	if( $opt_v ){
-		print "\nResult\n{$results}\n";
-		print "Expected\n{$expected}\n";
-	}
-}
-
-END { print "\n" if $out }
-
-
-1;
diff --git a/ext/Devel/DProf/t/test1.pl b/ext/Devel/DProf/t/test1.pl
deleted file mode 100644
index af792ed85c..0000000000
--- a/ext/Devel/DProf/t/test1.pl
+++ /dev/null
@@ -1,32 +0,0 @@
-END { print "main:: the end\n" }
-sub FOO::END { print "foo:: the end\n" }
-
-
-sub foo {
-	my $x;
-	my $y;
-	print "in sub foo\n";
-	for( $x = 1; $x < 100; ++$x ){
-		bar();
-		for( $y = 1; $y < 100; ++$y ){
-		}
-	}
-}
-
-sub bar {
-	my $x;
-	print "in sub bar\n";
-	for( $x = 1; $x < 100; ++$x ){
-	}
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	foo();
-}
-
-bar();
-baz();
-foo();
-
diff --git a/ext/Devel/DProf/t/test1.t b/ext/Devel/DProf/t/test1.t
deleted file mode 100644
index d504cd5536..0000000000
--- a/ext/Devel/DProf/t/test1.t
+++ /dev/null
@@ -1,18 +0,0 @@
-sub foo {
-	print "in sub foo\n";
-	bar();
-}
-
-sub bar {
-	print "in sub bar\n";
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	foo();
-}
-
-bar();
-baz();
-foo();
diff --git a/ext/Devel/DProf/t/test1.v b/ext/Devel/DProf/t/test1.v
deleted file mode 100644
index 542a503414..0000000000
--- a/ext/Devel/DProf/t/test1.v
+++ /dev/null
@@ -1,24 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$expected = 
-qq{main::bar
-main::baz
-   main::bar
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 1, sub { $expected eq $results };
-
-dprofpp('-TF');
-report 2, sub { $expected eq $results };
-
-dprofpp( '-t' );
-report 3, sub { $expected eq $results };
-
-dprofpp('-tF');
-report 4, sub { $expected eq $results };
diff --git a/ext/Devel/DProf/t/test2.t b/ext/Devel/DProf/t/test2.t
deleted file mode 100644
index edc46c527e..0000000000
--- a/ext/Devel/DProf/t/test2.t
+++ /dev/null
@@ -1,21 +0,0 @@
-sub foo {
-	print "in sub foo\n";
-	bar();
-}
-
-sub bar {
-	print "in sub bar\n";
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	bar();
-	bar();
-	foo();
-}
-
-bar();
-bar();
-baz();
-foo();
diff --git a/ext/Devel/DProf/t/test2.v b/ext/Devel/DProf/t/test2.v
deleted file mode 100644
index 3e9b18373b..0000000000
--- a/ext/Devel/DProf/t/test2.v
+++ /dev/null
@@ -1,36 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$expected =
-qq{main::bar
-main::bar
-main::baz
-   main::bar
-   main::bar
-   main::bar
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 1, sub { $expected eq $results };
-
-dprofpp('-TF');
-report 2, sub { $expected eq $results };
-
-dprofpp( '-t' );
-$expected =
-qq{main::bar (2x)
-main::baz
-   main::bar (3x)
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 3, sub { $expected eq $results };
-
-dprofpp('-tF');
-report 4, sub { $expected eq $results };
diff --git a/ext/Devel/DProf/t/test3.t b/ext/Devel/DProf/t/test3.t
deleted file mode 100644
index a5327f4d7a..0000000000
--- a/ext/Devel/DProf/t/test3.t
+++ /dev/null
@@ -1,19 +0,0 @@
-sub foo {
-	print "in sub foo\n";
-	exit(0);
-	bar();
-}
-
-sub bar {
-	print "in sub bar\n";
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	foo();
-}
-
-bar();
-baz();
-foo();
diff --git a/ext/Devel/DProf/t/test3.v b/ext/Devel/DProf/t/test3.v
deleted file mode 100644
index 31211c10d5..0000000000
--- a/ext/Devel/DProf/t/test3.v
+++ /dev/null
@@ -1,29 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$e1 = $expected =
-qq{main::bar
-main::baz
-   main::bar
-   main::foo
-};
-report 1, sub { $expected eq $results };
-
-dprofpp('-TF');
-$e2 = $expected =
-qq{main::bar
-main::baz
-   main::bar
-   main::foo
-};
-report 2, sub { $expected eq $results };
-
-dprofpp( '-t' );
-$expected = $e1;
-report 3, sub { 1 };
-
-dprofpp('-tF');
-$expected = $e2;
-report 4, sub { $expected eq $results };
diff --git a/ext/Devel/DProf/t/test4.t b/ext/Devel/DProf/t/test4.t
deleted file mode 100644
index 7d5a356272..0000000000
--- a/ext/Devel/DProf/t/test4.t
+++ /dev/null
@@ -1,24 +0,0 @@
-sub foo {
-	print "in sub foo\n";
-	bar();
-}
-
-sub bar {
-	print "in sub bar\n";
-}
-
-sub baz {
-	print "in sub baz\n";
-	bar();
-	bar();
-	bar();
-	foo();
-}
-
-bar();
-
-fork;
-
-bar();
-baz();
-foo();
diff --git a/ext/Devel/DProf/t/test4.v b/ext/Devel/DProf/t/test4.v
deleted file mode 100644
index 3e9b18373b..0000000000
--- a/ext/Devel/DProf/t/test4.v
+++ /dev/null
@@ -1,36 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$expected =
-qq{main::bar
-main::bar
-main::baz
-   main::bar
-   main::bar
-   main::bar
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 1, sub { $expected eq $results };
-
-dprofpp('-TF');
-report 2, sub { $expected eq $results };
-
-dprofpp( '-t' );
-$expected =
-qq{main::bar (2x)
-main::baz
-   main::bar (3x)
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 3, sub { $expected eq $results };
-
-dprofpp('-tF');
-report 4, sub { $expected eq $results };
diff --git a/ext/Devel/DProf/t/test5.t b/ext/Devel/DProf/t/test5.t
deleted file mode 100644
index 0b1113757f..0000000000
--- a/ext/Devel/DProf/t/test5.t
+++ /dev/null
@@ -1,25 +0,0 @@
-# Test that dprof doesn't break
-#    &bar;  used as &bar(@_);
-
-sub foo1 {
-	print "in foo1(@_)\n";
-	bar(@_);
-}
-sub foo2 {
-	print "in foo2(@_)\n";
-	&bar;
-}
-sub bar {
-	print "in bar(@_)\n";
-	if( @_ > 0 ){
-		&yeppers;
-	}
-}
-sub yeppers {
-	print "rest easy\n";
-}
-
-
-&foo1( A );
-&foo2( B );
-
diff --git a/ext/Devel/DProf/t/test5.v b/ext/Devel/DProf/t/test5.v
deleted file mode 100644
index 8f9025281f..0000000000
--- a/ext/Devel/DProf/t/test5.v
+++ /dev/null
@@ -1,15 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$expected =
-qq{main::foo1
-   main::bar
-      main::yeppers
-main::foo2
-   main::bar
-      main::yeppers
-};
-report 1, sub { $expected eq $results };
-
diff --git a/ext/Devel/DProf/t/test6.t b/ext/Devel/DProf/t/test6.t
deleted file mode 100644
index 7b8bf4a722..0000000000
--- a/ext/Devel/DProf/t/test6.t
+++ /dev/null
@@ -1,29 +0,0 @@
-sub foo {
-	my $x;
-	my $y;
-	print "in sub foo\n";
-	for( $x = 1; $x < 100; ++$x ){
-		bar();
-		for( $y = 1; $y < 100; ++$y ){
-		}
-	}
-}
-
-sub bar {
-	my $x;
-	print "in sub bar\n";
-	for( $x = 1; $x < 100; ++$x ){
-	}
-	die "bar exiting";
-}
-
-sub baz {
-	print "in sub baz\n";
-	eval { bar(); };
-	eval { foo(); };
-}
-
-eval { bar(); };
-baz();
-eval { foo(); };
-
diff --git a/ext/Devel/DProf/t/test6.v b/ext/Devel/DProf/t/test6.v
deleted file mode 100644
index 1236285f59..0000000000
--- a/ext/Devel/DProf/t/test6.v
+++ /dev/null
@@ -1,16 +0,0 @@
-# perl
-
-use V;
-
-dprofpp( '-T' );
-$expected =
-qq{main::bar
-main::baz
-   main::bar
-   main::foo
-      main::bar
-main::foo
-   main::bar
-};
-report 1, sub { $expected eq $results };
-
diff --git a/ext/Devel/DProf/test.pl b/ext/Devel/DProf/test.pl
deleted file mode 100644
index a889feccd8..0000000000
--- a/ext/Devel/DProf/test.pl
+++ /dev/null
@@ -1,79 +0,0 @@
-# perl
-
-require 5.003;
-
-use Benchmark qw( timediff timestr );
-use Getopt::Std 'getopts';
-use Config '%Config';
-getopts('vI:p:');
-
-# -v   Verbose
-# -I   Add to @INC
-# -p   Name of perl binary
-
-unless (-r 'dprofpp' and -M 'dprofpp' <= -M 'dprofpp.PL') {
-  print STDERR "dprofpp out of date, extracting...\n";
-  system 'perl', 'dprofpp.PL' and die 'perl dprofpp.PL: exit code $?, $!';
-}
-die "Need dprofpp, could not make it" unless -r 'dprofpp';
-
-chdir( 't' ) if -d 't';
-@tests = @ARGV ? @ARGV : sort <*.t *.v>;  # glob-sort, for OS/2
-
-$path_sep = $Config{path_sep} || ':';
-if( -d '../blib' ){
-	unshift @INC, '../blib/arch', '../blib/lib';
-}
-$perl5lib = $opt_I || join( $path_sep, @INC );
-$perl = $opt_p || $^X;
-
-if( $opt_v ){
-	print "tests: @tests\n";
-	print "perl: $perl\n";
-	print "perl5lib: $perl5lib\n";
-}
-if( $perl =~ m|^\./| ){
-	# turn ./perl into ../perl, because of chdir(t) above.
-	$perl = ".$perl";
-}
-if( ! -f $perl ){ die "Where's Perl?" }
-
-sub profile {
-	my $test = shift;
-	my @results;
-	local $ENV{PERL5LIB} = $perl5lib;
-	my $opt_d = '-d:DProf';
-
-	my $t_start = new Benchmark;
-	open( R, "$perl $opt_d $test |" ) || warn "$0: Can't run. $!\n";
-	@results = <R>;
-	close R;
-	my $t_total = timediff( new Benchmark, $t_start );
-
-	if( $opt_v ){
-		print "\n";
-		print @results
-	}
-
-	print timestr( $t_total, 'nop' ), "\n";
-}
-
-
-sub verify {
-	my $test = shift;
-
-	system $perl, '-I.', $test, $opt_v?'-v':'', '-p', $perl;
-}
-
-
-$| = 1;
-while( @tests ){
-	$test = shift @tests;
-	print $test . '.' x (20 - length $test);
-	if( $test =~ /t$/ ){
-		profile $test;
-	}
-	else{
-		verify $test;
-	}
-}