Revision: 1240
Author: tim.bunce
Date: Wed May 26 15:36:48 2010
Log: Fix filename_is_eval to allow "(eval N)" and not require the
trailing "[...]"
Sync tests after recent changes.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1240
Modified:
/trunk/NYTProf.xs
/trunk/t/42-global.t
/trunk/t/test23-strevall.rdt
=======================================
--- /trunk/NYTProf.xs Wed May 26 15:05:36 2010
+++ /trunk/NYTProf.xs Wed May 26 15:36:48 2010
@@ -552,7 +552,10 @@
static int
filename_is_eval(const char *filename, STRLEN filename_len)
{
- if (filename_len < 6 || filename[filename_len - 1] != ']')
+ if (filename_len < 6)
+ return 0;
+ /* typically "(eval N)[...]" sometimes just "(eval N)" */
+ if (filename[filename_len - 1] != ']' && filename[filename_len -
1] != ')')
return 0;
if (eval_prefix(filename, "(eval ", 6))
return 1;
@@ -872,6 +875,10 @@
);
found->eval_line_num = 1;
}
+ else {
+ if (trace_level >= 2)
+ logwarn("New fid has odd filename: '%.*s'\n",
file_name_len, file_name);
+ }
}
/* is the file is an autosplit, e.g., has a file_name like
=======================================
--- /trunk/t/42-global.t Mon May 24 07:37:09 2010
+++ /trunk/t/42-global.t Wed May 26 15:36:48 2010
@@ -28,7 +28,7 @@
my $subs1 = $profile->subname_subinfo_map;
- my $begin = ($pre589) ? 'main::BEGIN' : 'main::be...@3';
+ my $begin = ($pre589) ? 'main::BEGIN' : 'main::be...@4';
ok $subs1->{$begin};
ok $subs1->{'main::RUNTIME'};
ok $subs1->{'main::foo'};
@@ -39,7 +39,7 @@
my @a; # ($file, $fid, $first, $last);
@a = $profile->file_line_range_of_sub($begin);
- is "$a[1] $a[2] $a[3]", "$fid 3 6", "details for $begin should
match";
+ is "$a[1] $a[2] $a[3]", "$fid 4 7", "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,10 +51,15 @@
'keys from subname_subinfo_map and subs_defined_in_file should
match';
my @begins = grep { $_->subname =~ /\bBEGIN\b/ } values %$subs2;
- is @begins, ($pre589) ? 1 : 3,
- 'number of BEGIN subs';
- is grep({ $_->calls == 1 } @begins), scalar @begins,
- 'all BEGINs should be called just once';
+ if ($pre589) { # we only see one sub and we don't see it called
+ is @begins, 1, 'number of BEGIN subs';
+ is grep({ $_->calls == 1 } @begins), 0, 'BEGIN has no calls';
+ }
+ else {
+ is @begins, 3, 'number of BEGIN subs';
+ is grep({ $_->calls == 1 } @begins), scalar @begins,
+ 'all BEGINs should be called just once';
+ }
my $sub;
ok $sub = $subs2->{'main::RUNTIME'};
@@ -68,10 +73,10 @@
__DATA__
#!perl
sub foo { 42 }
+BEGIN { 'b' } BEGIN { 'c' } # two on same line
BEGIN { # be...@3
foo(2);
*CORE::GLOBAL::sleep = \&foo;
}
sleep 1;
-BEGIN { 'b' } BEGIN { 'c' } # two on same line
=======================================
--- /trunk/t/test23-strevall.rdt Wed Apr 21 04:41:03 2010
+++ /trunk/t/test23-strevall.rdt Wed May 26 15:36:48 2010
@@ -18,7 +18,7 @@
fid_fileinfo 1 [ test23-strevall.p 1 2 0 0 ]
fid_fileinfo 1 sub main::BEGIN 0-0
fid_fileinfo 2 [ (eval 0) 3 1 2 2 0 0 ]
-fid_fileinfo 3 [ /unknown-eval-invoker 3 130 0 0 ]
+fid_fileinfo 3 [ /unknown-eval-invoker 3 386 0 0 ]
fid_fileinfo 3 eval 1 [ count 1 nested 0 merged 0 ]
fid_line_time 1 4 [ 0 1 ]
fid_line_time 2 45 [ 0 1 ]
--
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]
