Integrate with Sarathy.

p4raw-id: //depot/cfgperl@3713

14 files changed, 425 insertions, 0 deletions

diff --git a/t/lib/dprof.t b/t/lib/dprof.t
new file mode 100755
index 0000000000..97e42bfcb2
--- /dev/null
+++ b/t/lib/dprof.t
@@ -0,0 +1,74 @@
+#!perl
+
+BEGIN {
+    chdir( 't' ) if -d 't';
+    unshift @INC, '../lib';
+}
+
+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
+
+@tests = @ARGV ? @ARGV : sort <lib/dprof/*_t lib/dprof/*_v>;  # glob-sort, for OS/2
+
+$path_sep = $Config{path_sep} || ':';
+$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../lib', '-I./lib/dprof', $test,
+		$opt_v?'-v':'', '-p', $perl;
+}
+
+
+$| = 1;
+print "1..18\n";
+while( @tests ){
+	$test = shift @tests;
+	if( $test =~ /_t$/i ){
+		print "# $test" . '.' x (20 - length $test);
+		profile $test;
+	}
+	else{
+		verify $test;
+	}
+}
diff --git a/t/lib/dprof/V.pm b/t/lib/dprof/V.pm
new file mode 100644
index 0000000000..7e34da5d47
--- /dev/null
+++ b/t/lib/dprof/V.pm
@@ -0,0 +1,59 @@
+package V;
+
+use Getopt::Std 'getopts';
+getopts('vp:d:');
+
+require Exporter;
+@ISA = 'Exporter';
+
+@EXPORT = qw( dprofpp $opt_v $results $expected report @results );
+@EXPORT_OK = qw( notok ok $num );
+
+$num = 0;
+$results = $expected = '';
+$perl = $opt_p || $^X;
+$dpp = $opt_d || '../utils/dprofpp';
+
+print "\nperl: $perl\n" if $opt_v;
+if( ! -f $perl ){ die "Where's Perl?" }
+if( ! -f $dpp ){ die "Where's dprofpp?" }
+
+sub dprofpp {
+	my $switches = shift;
+
+	open( D, "$perl -I../lib $dpp $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 {
+	print "ok $num\n";
+}
+
+sub notok {
+	print "not ok $num\n";
+	print "\nResult\n{$results}\n";
+	print "Expected\n{$expected}\n";
+}
+
+1;
diff --git a/t/lib/dprof/test1_t b/t/lib/dprof/test1_t
new file mode 100644
index 0000000000..d504cd5536
--- /dev/null
+++ b/t/lib/dprof/test1_t
@@ -0,0 +1,18 @@
+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/t/lib/dprof/test1_v b/t/lib/dprof/test1_v
new file mode 100644
index 0000000000..542a503414
--- /dev/null
+++ b/t/lib/dprof/test1_v
@@ -0,0 +1,24 @@
+# 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/t/lib/dprof/test2_t b/t/lib/dprof/test2_t
new file mode 100644
index 0000000000..edc46c527e
--- /dev/null
+++ b/t/lib/dprof/test2_t
@@ -0,0 +1,21 @@
+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/t/lib/dprof/test2_v b/t/lib/dprof/test2_v
new file mode 100644
index 0000000000..8b775b3131
--- /dev/null
+++ b/t/lib/dprof/test2_v
@@ -0,0 +1,36 @@
+# 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 5, sub { $expected eq $results };
+
+dprofpp('-TF');
+report 6, 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 7, sub { $expected eq $results };
+
+dprofpp('-tF');
+report 8, sub { $expected eq $results };
diff --git a/t/lib/dprof/test3_t b/t/lib/dprof/test3_t
new file mode 100644
index 0000000000..a5327f4d7a
--- /dev/null
+++ b/t/lib/dprof/test3_t
@@ -0,0 +1,19 @@
+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/t/lib/dprof/test3_v b/t/lib/dprof/test3_v
new file mode 100644
index 0000000000..df7543e2b8
--- /dev/null
+++ b/t/lib/dprof/test3_v
@@ -0,0 +1,29 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$e1 = $expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+};
+report 9, sub { $expected eq $results };
+
+dprofpp('-TF');
+$e2 = $expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+};
+report 10, sub { $expected eq $results };
+
+dprofpp( '-t' );
+$expected = $e1;
+report 11, sub { 1 };
+
+dprofpp('-tF');
+$expected = $e2;
+report 12, sub { $expected eq $results };
diff --git a/t/lib/dprof/test4_t b/t/lib/dprof/test4_t
new file mode 100644
index 0000000000..729968270a
--- /dev/null
+++ b/t/lib/dprof/test4_t
@@ -0,0 +1,24 @@
+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();
+
+eval { fork };
+
+bar();
+baz();
+foo();
diff --git a/t/lib/dprof/test4_v b/t/lib/dprof/test4_v
new file mode 100644
index 0000000000..d9677ff785
--- /dev/null
+++ b/t/lib/dprof/test4_v
@@ -0,0 +1,36 @@
+# 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 13, sub { $expected eq $results };
+
+dprofpp('-TF');
+report 14, 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 15, sub { $expected eq $results };
+
+dprofpp('-tF');
+report 16, sub { $expected eq $results };
diff --git a/t/lib/dprof/test5_t b/t/lib/dprof/test5_t
new file mode 100644
index 0000000000..0b1113757f
--- /dev/null
+++ b/t/lib/dprof/test5_t
@@ -0,0 +1,25 @@
+# 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/t/lib/dprof/test5_v b/t/lib/dprof/test5_v
new file mode 100644
index 0000000000..9e9298c689
--- /dev/null
+++ b/t/lib/dprof/test5_v
@@ -0,0 +1,15 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::foo1
+   main::bar
+      main::yeppers
+main::foo2
+   main::bar
+      main::yeppers
+};
+report 17, sub { $expected eq $results };
+
diff --git a/t/lib/dprof/test6_t b/t/lib/dprof/test6_t
new file mode 100644
index 0000000000..7b8bf4a722
--- /dev/null
+++ b/t/lib/dprof/test6_t
@@ -0,0 +1,29 @@
+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/t/lib/dprof/test6_v b/t/lib/dprof/test6_v
new file mode 100644
index 0000000000..2f651ea794
--- /dev/null
+++ b/t/lib/dprof/test6_v
@@ -0,0 +1,16 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::bar
+main::baz
+   main::bar
+   main::foo
+      main::bar
+main::foo
+   main::bar
+};
+report 18, sub { $expected eq $results };
+