Revision: 986 Author: tim.bunce Date: Tue Dec 22 11:15:32 2009 Log: Tweaked be...@line test to cater for pre 5.8.9 and noted limitation in Changes.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=986 Modified: /trunk/Changes /trunk/t/42-global.t ======================================= --- /trunk/Changes Sun Dec 20 15:44:19 2009 +++ /trunk/Changes Tue Dec 22 11:15:32 2009 @@ -62,8 +62,9 @@ linking of call trees. Previously only the calling file and line were recorded. (This is more significant than it sounds :) Added docs describing how the subroutine profiler works. - Multiple BEGIN blocks (i.e., "use") within a package are now distinguished - by appending the number of the line they start on. + Multiple BEGIN blocks (including "use") within a package are now + distinguished by appending the number of the line they start on + (for perl 5.8.9+ and 5.10.1+) Changes to nytprofhtml: ======================================= --- /trunk/t/42-global.t Sun Dec 20 15:44:19 2009 +++ /trunk/t/42-global.t Tue Dec 22 11:15:32 2009 @@ -9,6 +9,8 @@ use Devel::NYTProf::Run qw(profile_this); +my $pre589 = ($] < 5.008009 or $] eq "5.010000"); + run_test_group( { extra_options => { start => 'begin' }, extra_test_count => 16, @@ -30,9 +32,11 @@ isa_ok $profile, 'Devel::NYTProf::Data'; my $subs = $profile->subname_subinfo_map; - - is scalar keys %$subs, 3, "should be 3 subs (found: @{[ keys %$subs ]})"; - ok $subs->{'main::be...@3'}; + print "subs: @{[ keys %$subs ]}\n"; + + my $begin = ($pre589) ? 'main::BEGIN' : 'main::be...@3'; + is scalar keys %$subs, 3, "should be 3 subs"; + ok $subs->{$begin}; ok $subs->{'main::RUNTIME'}; ok $subs->{'main::foo'}; @@ -41,8 +45,8 @@ my $fid = $fi[0]->fid; my @a; # ($file, $fid, $first, $last); - @a = $profile->file_line_range_of_sub('main::be...@3'); - is "$a[1] $a[2] $a[3]", "$fid 3 6", 'details for main::BEGIN should match'; + @a = $profile->file_line_range_of_sub($begin); + is "$a[1] $a[2] $a[3]", "$fid 3 6", "details for $begin should match"; @a = $profile->file_line_range_of_sub('main::RUNTIME'); is "$a[1] $a[2] $a[3]", "$fid 1 1", 'details for main::RUNTIME should match'; @a = $profile->file_line_range_of_sub('main::foo'); @@ -51,11 +55,10 @@ $subs = $profile->subs_defined_in_file($fid); my $sub; is scalar keys %$subs, 3, 'should be 3 subs'; - ok $sub = $subs->{'main::be...@3'}; + ok $sub = $subs->{$begin}; SKIP: { - skip "needs perl >= 5.8.9 or >= 5.10.1", 1 - if $] < 5.008009 or $] eq "5.010000"; - is $sub->calls, 1, 'main::BEGIN should be called 1 time'; + skip "needs perl >= 5.8.9 or >= 5.10.1", 1 if $pre589; + is $sub->calls, 1, "$begin should be called 1 time"; }; ok $sub = $subs->{'main::RUNTIME'}; is $sub->calls, 0, 'main::RUNTIME should be called 0 times'; -- 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]
