summaryrefslogtreecommitdiff
path: root/cpan/Devel-DProf/dprof
diff options
context:
space:
mode:
Diffstat (limited to 'cpan/Devel-DProf/dprof')
-rw-r--r--cpan/Devel-DProf/dprof/V.pm63
-rw-r--r--cpan/Devel-DProf/dprof/test1_t18
-rw-r--r--cpan/Devel-DProf/dprof/test1_v24
-rw-r--r--cpan/Devel-DProf/dprof/test2_t21
-rw-r--r--cpan/Devel-DProf/dprof/test2_v36
-rw-r--r--cpan/Devel-DProf/dprof/test3_t19
-rw-r--r--cpan/Devel-DProf/dprof/test3_v29
-rw-r--r--cpan/Devel-DProf/dprof/test4_t24
-rw-r--r--cpan/Devel-DProf/dprof/test4_v36
-rw-r--r--cpan/Devel-DProf/dprof/test5_t25
-rw-r--r--cpan/Devel-DProf/dprof/test5_v15
-rw-r--r--cpan/Devel-DProf/dprof/test6_t29
-rw-r--r--cpan/Devel-DProf/dprof/test6_v16
-rw-r--r--cpan/Devel-DProf/dprof/test7_t9
-rw-r--r--cpan/Devel-DProf/dprof/test7_v10
-rw-r--r--cpan/Devel-DProf/dprof/test8_t15
-rw-r--r--cpan/Devel-DProf/dprof/test8_v11
17 files changed, 400 insertions, 0 deletions
diff --git a/cpan/Devel-DProf/dprof/V.pm b/cpan/Devel-DProf/dprof/V.pm
new file mode 100644
index 0000000000..e613f6f441
--- /dev/null
+++ b/cpan/Devel-DProf/dprof/V.pm
@@ -0,0 +1,63 @@
+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';
+$dpp .= '.com' if $^O eq 'VMS';
+
+print "\nperl: $perl\n" if $opt_v;
+if( ! -f $perl ){ die "Where's Perl?" }
+if( ! -f $dpp ) {
+ ($dpp = $^X) =~ s@(^.*)[/|\\].*@$1/dprofpp@;
+ die "Where's dprofpp?" if( ! -f $dpp );
+}
+
+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/cpan/Devel-DProf/dprof/test1_t b/cpan/Devel-DProf/dprof/test1_t
new file mode 100644
index 0000000000..d504cd5536
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test1_v b/cpan/Devel-DProf/dprof/test1_v
new file mode 100644
index 0000000000..542a503414
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test2_t b/cpan/Devel-DProf/dprof/test2_t
new file mode 100644
index 0000000000..edc46c527e
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test2_v b/cpan/Devel-DProf/dprof/test2_v
new file mode 100644
index 0000000000..8b775b3131
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test3_t b/cpan/Devel-DProf/dprof/test3_t
new file mode 100644
index 0000000000..a5327f4d7a
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test3_v b/cpan/Devel-DProf/dprof/test3_v
new file mode 100644
index 0000000000..df7543e2b8
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test4_t b/cpan/Devel-DProf/dprof/test4_t
new file mode 100644
index 0000000000..729968270a
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test4_v b/cpan/Devel-DProf/dprof/test4_v
new file mode 100644
index 0000000000..d9677ff785
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test5_t b/cpan/Devel-DProf/dprof/test5_t
new file mode 100644
index 0000000000..0b1113757f
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test5_v b/cpan/Devel-DProf/dprof/test5_v
new file mode 100644
index 0000000000..9e9298c689
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test6_t b/cpan/Devel-DProf/dprof/test6_t
new file mode 100644
index 0000000000..7b8bf4a722
--- /dev/null
+++ b/cpan/Devel-DProf/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/cpan/Devel-DProf/dprof/test6_v b/cpan/Devel-DProf/dprof/test6_v
new file mode 100644
index 0000000000..2f651ea794
--- /dev/null
+++ b/cpan/Devel-DProf/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 };
+
diff --git a/cpan/Devel-DProf/dprof/test7_t b/cpan/Devel-DProf/dprof/test7_t
new file mode 100644
index 0000000000..56dbfd341c
--- /dev/null
+++ b/cpan/Devel-DProf/dprof/test7_t
@@ -0,0 +1,9 @@
+BEGIN {
+ print "in BEGIN\n";
+}
+
+sub foo {
+ print "in sub foo\n";
+}
+
+foo();
diff --git a/cpan/Devel-DProf/dprof/test7_v b/cpan/Devel-DProf/dprof/test7_v
new file mode 100644
index 0000000000..1d19fe5cd5
--- /dev/null
+++ b/cpan/Devel-DProf/dprof/test7_v
@@ -0,0 +1,10 @@
+# perl
+
+use V;
+
+dprofpp( '-T' );
+$expected =
+qq{main::BEGIN
+main::foo
+};
+report 19, sub { $expected eq $results };
diff --git a/cpan/Devel-DProf/dprof/test8_t b/cpan/Devel-DProf/dprof/test8_t
new file mode 100644
index 0000000000..6154c8a530
--- /dev/null
+++ b/cpan/Devel-DProf/dprof/test8_t
@@ -0,0 +1,15 @@
+sub foo {
+ print "in sub foo\n";
+}
+
+sub bar {
+ print "in sub bar\n";
+ $^P -= 0x40;
+}
+
+foo();
+$^P -= 0x40;
+foo();
+$^P += 0x40;
+bar();
+$^P += 0x40;
diff --git a/cpan/Devel-DProf/dprof/test8_v b/cpan/Devel-DProf/dprof/test8_v
new file mode 100644
index 0000000000..d5de3087fe
--- /dev/null
+++ b/cpan/Devel-DProf/dprof/test8_v
@@ -0,0 +1,11 @@
+# perl
+
+use V;
+
+dprofpp( '-t' );
+$expected =
+qq{main::foo (2x)
+main::bar
+};
+
+report 20, sub { $expected eq $results };
View Lorry Controller Status