Revision: 1071
Author: tim.bunce
Date: Sat Feb 20 07:28:32 2010
Log: Removed $fi->is_perl_std_lib and addressed the underlying need another
way. Fixes RT#54204.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=1071
Modified:
/trunk/NYTProf.xs
/trunk/bin/nytprofmerge
/trunk/lib/Devel/NYTProf/Data.pm
/trunk/lib/Devel/NYTProf/FileInfo.pm
/trunk/lib/Devel/NYTProf/SubInfo.pm
/trunk/t/00-load.t
/trunk/t/lib/NYTProfTest.pm
=======================================
--- /trunk/NYTProf.xs Sat Feb 20 05:21:47 2010
+++ /trunk/NYTProf.xs Sat Feb 20 07:28:32 2010
@@ -458,11 +458,6 @@
/* $0 - application name */
sv = get_sv("0",GV_ADDWARN);
NYTP_printf(out, ":%s=%s\n", "application", SvPV_nolen(sv));
- /* %Config values */
- NYTP_printf(out, ":%s=%s\n", "PRIVLIB_EXP", PRIVLIB_EXP);
-#ifdef ARCHLIB_EXP /* not defined if would be same as PRIVLIB_EXP */
- NYTP_printf(out, ":%s=%s\n", "ARCHLIB_EXP", ARCHLIB_EXP);
-#endif
#ifdef HAS_ZLIB
if (compression_level) {
=======================================
--- /trunk/bin/nytprofmerge Wed Feb 17 08:36:02 2010
+++ /trunk/bin/nytprofmerge Sat Feb 20 07:28:32 2010
@@ -79,7 +79,7 @@
# Croak if any of these attributes differ between profiles
my %identical = map {$_, 1}
- qw (ARCHLIB_EXP PL_perldb PRIVLIB_EXP clock_id nv_size perl_version
+ qw (PL_perldb clock_id nv_size perl_version
ticks_per_sec xs_version);
# Effectively, these are global variables. Sorry.
=======================================
--- /trunk/lib/Devel/NYTProf/Data.pm Mon Jan 4 13:42:33 2010
+++ /trunk/lib/Devel/NYTProf/Data.pm Sat Feb 20 07:28:32 2010
@@ -325,8 +325,6 @@
my $separator = $args->{separator} || '';
my $filehandle = $args->{filehandle} || \*STDOUT;
- #skip_stdlib
-
# shallow clone and add sub_caller for migration of tests
my $startnode = $self;
@@ -335,31 +333,27 @@
my $callback = sub {
my ($path, $value) = @_;
- if ($path->[0] eq 'attribute' && @$path == 1) {
- my %v = %$value;
- delete @v{qw(PRIVLIB_EXP ARCHLIB_EXP)};
- return ({}, \%v);
- }
-
- if ($args->{skip_stdlib}) {
+ # not needed currently
+ #if ($path->[0] eq 'attribute' && @$path == 1) { my %v = %$value;
return ({}, \%v); }
+
+ if (my $hook = $args->{skip_fileinfo_hook}) {
# for fid_fileinfo don't dump internal details of lib modules
if ($path->[0] eq 'fid_fileinfo' && @$path==2) {
my $fi = $self->fileinfo_of($value->[0]);
- return ({ skip_internal_details => $fi->is_perl_std_lib },
$value);
+ return ({ skip_internal_details => scalar $hook->($fi,
$path, $value) }, $value);
}
# skip sub_subinfo data for 'library modules'
if ($path->[0] eq 'sub_subinfo' && @$path==2 && $value->[0]) {
my $fi = $self->fileinfo_of($value->[0]);
- return undef if $fi->is_perl_std_lib;
+ return undef if $hook->($fi, $path, $value);
}
# skip fid_*_time data for 'library modules'
if ($path->[0] =~ /^fid_\w+_time$/ && @$path==2) {
my $fi = $self->fileinfo_of($path->[1]);
- return undef if $fi->is_perl_std_lib
- or $fi->filename =~ m!^/\.\.\./!;
+ return undef if $hook->($fi, $path, $value)
}
}
return ({}, $value);
=======================================
--- /trunk/lib/Devel/NYTProf/FileInfo.pm Sat Feb 20 04:45:40 2010
+++ /trunk/lib/Devel/NYTProf/FileInfo.pm Sat Feb 20 07:28:32 2010
@@ -112,18 +112,6 @@
sub is_pmc {
return (shift->flags & NYTP_FIDf_IS_PMC());
}
-
-
-sub is_perl_std_lib {
- my $self = shift;
- my $filename = $self->filename;
- my $attributes = $self->profile->attributes;
- for (@{$attributes}{qw(PRIVLIB_EXP ARCHLIB_EXP)}) {
- next unless $_;
- return 1 if $filename =~ /\Q$_/;
- }
- return 0;
-}
# should return the filename that the application used
=======================================
--- /trunk/lib/Devel/NYTProf/SubInfo.pm Sat Feb 20 04:45:40 2010
+++ /trunk/lib/Devel/NYTProf/SubInfo.pm Sat Feb 20 07:28:32 2010
@@ -218,11 +218,12 @@
# { fid => { line => [ count, incl, excl, ucpu, scpu, reci, recdepth ]
} }
my $callers = $self->caller_fid_line_places || {};
- # delete calls from modules shipped with perl
+ # delete calls from modules shipped with perl that some tests use
+ # (because the line numbers vary between perl versions)
for my $fid (keys %$callers) {
next if not $fid;
my $fileinfo = $profile->fileinfo_of($fid) or next;
- next if not $fileinfo->is_perl_std_lib;
+ next if $fileinfo->filename !~ /(AutoLoader|Exporter)\.pm$/;
delete $callers->{$fid};
}
=======================================
--- /trunk/t/00-load.t Mon Jan 4 13:42:33 2010
+++ /trunk/t/00-load.t Sat Feb 20 07:28:32 2010
@@ -19,7 +19,6 @@
diag "--- Perl $] Config on $Config{archname}:";
diag "\t$_: ".(defined $Config{$_} ? $Config{$_} : '(undef)')
for qw(
- privlibexp archlibexp vendorlibexp
d_gettimeod
);
=======================================
--- /trunk/t/lib/NYTProfTest.pm Sat Feb 20 04:42:34 2010
+++ /trunk/t/lib/NYTProfTest.pm Sat Feb 20 07:28:32 2010
@@ -397,7 +397,11 @@
$profile->dump_profile_data(
{ filehandle => $fh,
separator => "\t",
- skip_stdlib => 1,
+ skip_fileinfo_hook => sub {
+ my $fi = shift;
+ return 1 if $fi->filename =~ /(AutoLoader|Exporter)\.pm$/
or $fi->filename =~ m!^/\.\.\./!;
+ return 0;
+ },
}
);
return;
--
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]
