Revision: 1273
Author: [email protected]
Date: Mon Jun 7 06:52:24 2010
Log: Extensions to other tests
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1273
Modified:
/trunk/t/42-global.t
/trunk/t/test20-streval.t
/trunk/t/test22-strevala.t
=======================================
--- /trunk/t/42-global.t Wed May 26 15:36:48 2010
+++ /trunk/t/42-global.t Mon Jun 7 06:52:24 2010
@@ -15,7 +15,7 @@
run_test_group( {
extra_options => { start => 'begin' },
- extra_test_count => 15,
+ extra_test_count => 17,
extra_test_code => sub {
my ($profile, $env) = @_;
@@ -67,6 +67,9 @@
ok $sub = $subs2->{'main::foo'};
is $sub->calls, 2, 'main::foo should be called 2 times';
+ ok my $called_by_subnames = $sub->called_by_subnames;
+ is keys %$called_by_subnames, 2, 'should be called from 2 subs';
+
},
});
=======================================
--- /trunk/t/test20-streval.t Fri Feb 6 01:47:28 2009
+++ /trunk/t/test20-streval.t Mon Jun 7 06:52:24 2010
@@ -2,5 +2,45 @@
use Test::More;
use lib qw(t/lib);
use NYTProfTest;
-
-run_test_group;
+use Devel::NYTProf::Constants qw(NYTP_SCi_elements);
+
+run_test_group( {
+ extra_test_count => 8 + (3 * 6),
+ extra_test_code => sub {
+ my ($profile, $env) = @_;
+
+ # check sub callers from sub perspective
+ my $subs = $profile->subname_subinfo_map;
+ my $si = $subs->{'main::foo'};
+ ok $si;
+ is $si->calls, 4;
+ my $called_by_subnames = $si->called_by_subnames;
+ ok $called_by_subnames;
+ is_deeply [ keys %$called_by_subnames ],
+ [ 'main::RUNTIME' ],
+ 'should be called from only from main::RUNTIME';
+
+ my $callers = $si->caller_fid_line_places;
+ ok $callers;
+ #warn Data::Dumper::Dumper($callers);
+ # two calls from evals on same line get collapsed
+ my @fids = keys %$callers;
+ is @fids, 3, 'should be called from 3 files';
+ is_deeply [ map { keys %$_ } values %$callers ], [ 1, 1, 1 ],
+ 'should all be called from line 1';
+ my @sc = map { values %$_ } values %$callers;
+ is_deeply [ map { scalar @$_ } @sc ], [ (NYTP_SCi_elements()) x 3],
+ 'all sub calls infos should have all elements';
+
+ # check sub callers from file perspective
+ for my $fid (@fids) {
+ ok my $fi = $profile->fileinfo_of($fid);
+ ok my $sub_call_lines = $fi->sub_call_lines;
+ #warn Data::Dumper::Dumper($sub_call_lines);
+ is keys %$sub_call_lines, 1;
+ is keys %{$sub_call_lines->{1}}, 1;
+ ok my $sc = $sub_call_lines->{1}{'main::foo'};
+ is @$sc, NYTP_SCi_elements(), 'si should have all elements';
+ }
+ },
+} );
=======================================
--- /trunk/t/test22-strevala.t Mon May 3 13:49:06 2010
+++ /trunk/t/test22-strevala.t Mon Jun 7 06:52:24 2010
@@ -1,8 +1,61 @@
use strict;
use Test::More;
+use List::Util qw(sum);
use lib qw(t/lib);
use NYTProfTest;
+# don't normalize eval seqn because doing so would create duplicates
$ENV{NYTPROF_TEST_SKIP_EVAL_NORM} = 1;
-run_test_group;
+use Devel::NYTProf::Constants qw(NYTP_SCi_elements);
+
+run_test_group( {
+ extra_test_count => 2 + (3 * 3),
+ extra_test_code => sub {
+ my ($profile, $env) = @_;
+
+ # check sub callers from sub perspective
+ my $subs = $profile->subname_subinfo_map;
+ my @anon = grep { $_->is_anon } values %$subs;
+ is @anon, 3, 'should be 3 anon subs (after merging)';
+ is sum(map { $_->calls } @anon), 5, 'call count';
+
+ my %fids;
+ for my $si (@anon) {
+ printf "------ sub %s\n", $si->subname;
+ my $called_by_subnames = $si->called_by_subnames;
+ ok $called_by_subnames;
+ is_deeply [ keys %$called_by_subnames ],
+ [ 'main::RUNTIME' ],
+ 'should be called from only from main::RUNTIME';
+
+ my $callers = $si->caller_fid_line_places;
+ ok $callers;
+
print "caller_fid_line_places: ".Data::Dumper::Dumper($callers);
+
+ ++$fids{$_} for keys %$callers;
+ }
+
+ return;
+
+ # check sub callers from file perspective
+ for my $fid (keys %fids) {
+ print "------ fid $fid\n";
+ ok my $fi = $profile->fileinfo_of($fid);
+ ok my $sub_call_lines = $fi->sub_call_lines;
+ warn "sub_call_lines: ".Data::Dumper::Dumper($sub_call_lines);
+ is keys %$sub_call_lines, 1;
+ is keys %{$sub_call_lines->{1}}, 1;
+ ok my $sc = $sub_call_lines->{1}{'main::foo'};
+ is @$sc, NYTP_SCi_elements(), 'si should have all elements';
+ }
+ },
+} );
+
+__END__
+my $code = 'sub { print "sub called\n" }';
+eval($code)->();
+eval($code)->(); eval($code)->();
+eval q{
+ eval($code)->(); eval($code)->();
+};
--
You've received this message because you are subscribed to
the Devel::NYTProf Development User group.
Group hosted at: http://groups.google.com/group/develnytprof-dev
Project hosted at: http://perl-devel-nytprof.googlecode.com
CPAN distribution: http://search.cpan.org/dist/Devel-NYTProf
To post, email: [email protected]
To unsubscribe, email: [email protected]
