Revision: 980
Author: tim.bunce
Date: Fri Dec 18 14:29:46 2009
Log: Added crude testing of nytprofmerge. For every test with a .rdt file
the .rdt file is
checked normally and then checked again using data run though nytprofmerge.
This 'null merge' ought to still generate the same data dump as the .rdt
file.
The easiest way to enable the test is to set the NYTPROF_TEST_MERGERDT env
var.
Currently there's only one test failing: t/test23-strevall.t
The key difference is:
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 eval 1 [ 1 0 ]
+fid_fileinfo 2 [ /unknown-eval-invoker 2 130 0 0 ]
+fid_fileinfo 2 eval 1 [ 1 0 ]
+fid_fileinfo 3 [ (eval 0) 2 1 3 2 0 0 ]
This isn't a real problem. It's caused by NYTProf writing fids out of order
(3 before 2, due to recursion in get_file_id()) in the specific case of
evals
that don't have a known invoker. Probably not worth 'fixing'.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=980
Modified:
/trunk/t/lib/NYTProfTest.pm
=======================================
--- /trunk/t/lib/NYTProfTest.pm Tue Dec 8 05:17:48 2009
+++ /trunk/t/lib/NYTProfTest.pm Fri Dec 18 14:29:46 2009
@@ -23,8 +23,6 @@
use Devel::NYTProf::Util qw(strip_prefix_from_paths html_safe_filename);
-my $tests_per_extn = {p => 1, rdt => 1, x => 3};
-
my $this_perl = $^X;
$this_perl .= $Config{_exe} if $^O ne 'VMS' and $this_perl !~
m/$Config{_exe}$/i;
@@ -32,6 +30,7 @@
one => $ENV{NYTPROF_TEST_ONE},
profperlopts => $ENV{NYTPROF_TEST_PROFPERLOPTS} || '-d:NYTProf',
html => $ENV{NYTPROF_TEST_HTML},
+ mergerdt => $ENV{NYTPROF_TEST_MERGERDT}, # overkill, but handy
);
GetOptions(\%opts, qw/p=s I=s v|verbose d|debug html open profperlopts=s
leave=i use_db_sub=i savesrc=i compress=i one abort/)
or exit 1;
@@ -59,6 +58,12 @@
}
+my $tests_per_extn = {
+ p => 1,
+ rdt => ($opts{mergerdt}) ? 2 : 1,
+ x => 3
+};
+
chdir('t') if -d 't';
if (-d '../blib') {
@@ -67,6 +72,7 @@
my $bindir = (grep {-d} qw(./blib/script ../blib/script))[0];
my $nytprofcsv = "$bindir/nytprofcsv";
my $nytprofhtml = "$bindir/nytprofhtml";
+my $nytprofmerge= "$bindir/nytprofmerge";
my $path_sep = $Config{path_sep} || ':';
my $perl5lib = $opts{I} || join($path_sep, @INC);
@@ -124,6 +130,7 @@
sub do_foreach_opt_combination {
my ($opt_combinations, $code) = @_;
+
COMBINATION:
for my $env (@$opt_combinations) {
@@ -147,8 +154,8 @@
# did any tests fail?
my $failed = (count_of_failed_tests() - $prev_failures) ? 1 : 0;
# record what env settings may have influenced the failure
- ++$env_influence{$_}{$env->{$_}}{$failed ? 'fail' : 'pass'} for
keys %$env;
-
+ ++$env_influence{$_}{$env->{$_}}{$failed ? 'fail' : 'pass'}
+ for keys %$env;
}
}
@@ -282,6 +289,15 @@
}
elsif ($type eq 'rdt') {
verify_data($test, $tag, $test_datafile);
+
+ if ($opts{mergerdt}) { # run the file through nytprofmerge
+ my $merged = "$profile_datafile.merged";
+ my $merge_cmd = "$nytprofmerge -v --out=$merged
$test_datafile";
+ system($merge_cmd) == 0
+ or die "Error running $merge_cmd\n";
+ verify_data($test, "$tag (merged)", $merged);
+ unlink $merged;
+ }
}
elsif ($type eq 'x') {
mkdir $outdir or die "mkdir($outdir): $!" unless -d $outdir;
@@ -350,7 +366,8 @@
}
SKIP: {
- skip 'Expected profile data does not have VMS paths',1 if(($^O
eq 'VMS') && ($test =~m/test60|test14/i));
+ skip 'Expected profile data does not have VMS paths', 1
+ if $^O eq 'VMS' and $test =~ m/test60|test14/i;
$profile->normalize_variables;
dump_profile_to_file($profile, $test.'_new', $test.'_newp');
my @got = slurp_file($test.'_new'); chomp @got;
--
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]
