Revision: 904 Author: tim.bunce Date: Sat Nov 14 15:33:22 2009 Log: Added Devel::NYTProf::Run module with profile_this(src_code=>"...") function. Enabled run_test_group to not require any external test files. (Together they enable traditional style Test::More tests to be applied to source code without requiring external test files but still allowing multiple executions with combinations of NYTPROF env var settings. This provides an escape route from the tyranny of the dump-n-diff approach.)
http://code.google.com/p/perl-devel-nytprof/source/detail?r=904 Added: /trunk/lib/Devel/NYTProf/Run.pm /trunk/t/10-run.t Modified: /trunk/MANIFEST /trunk/t/lib/NYTProfTest.pm ======================================= --- /dev/null +++ /trunk/lib/Devel/NYTProf/Run.pm Sat Nov 14 15:33:22 2009 @@ -0,0 +1,75 @@ +package Devel::NYTProf::Run; + +# vim: ts=8 sw=4 expandtab: +########################################################## +# This script is part of the Devel::NYTProf distribution +# +# Copyright, contact and other information can be found +# at the bottom of this file, or by going to: +# http://search.cpan.org/dist/Devel-NYTProf/ +# +########################################################### +# $Id: Util.pm 809 2009-07-07 13:24:31Z tim.bunce $ +########################################################### + +=head1 NAME + +Devel::NYTProf::Run - Invoke NYTProf on a piece of code and return the profile + +=head1 SYNOPSIS + +=head1 DESCRIPTION + +This module is experimental and subject to change. + +=cut + +use warnings; +use strict; + +use base qw(Exporter); + +use Carp; +use Config qw(%Config); +use Devel::NYTProf::Data; + +our @EXPORT_OK = qw( + profile_this +); + + +my $this_perl = $^X; +$this_perl .= $Config{_exe} if $^O ne 'VMS' and $this_perl !~ m/$Config{_exe}$/i; + + +sub profile_this { + my %opt = @_; + + my $out_file = $opt{out_file} || 'nytprof.out'; + + my @perl = ($this_perl, '-d:NYTProf'); + push @perl, @{ $opt{perl_opts} } if $opt{perl_opts}; + + if (my $src_file = $opt{src_file}) { + system(@perl, $src_file) == 0 + or carp "@perl $src_file exited with an error status"; + } + elsif (my $src_code = $opt{src_code}) { + open my $fh, '|-', @perl + or croak "Can't open pipe to @perl"; + print $fh $src_code; + close $fh + or carp "@perl exited with an error status"; + } + else { + croak "Neither src_file or src_code was provided"; + } + + my $profile = Devel::NYTProf::Data->new( { filename => $out_file } ); + + unlink $out_file; + + return $profile; +} + +1; ======================================= --- /dev/null +++ /trunk/t/10-run.t Sat Nov 14 15:33:22 2009 @@ -0,0 +1,20 @@ +use Test::More; + +use strict; +use lib qw(t/lib); + +use NYTProfTest; + +use Devel::NYTProf::Run qw(profile_this); + +run_test_group( { + extra_test_count => 1, + _extra_test_code => sub { + my ($profile, $env) = @_; + + $profile = profile_this( + src_code => "1+1" + ); + isa_ok $profile, 'Devel::NYTProf::Data'; + }, +}); ======================================= --- /trunk/MANIFEST Sat Oct 24 08:56:24 2009 +++ /trunk/MANIFEST Sat Nov 14 15:33:22 2009 @@ -25,6 +25,7 @@ lib/Devel/NYTProf/PgPLPerl.pm lib/Devel/NYTProf/ReadStream.pm lib/Devel/NYTProf/Reader.pm +lib/Devel/NYTProf/Run.pm lib/Devel/NYTProf/SubInfo.pm lib/Devel/NYTProf/Test.pm lib/Devel/NYTProf/Util.pm @@ -47,6 +48,7 @@ ppport.h slowops.h t/00-load.t +t/10-run.t t/22-readstream.t t/30-util.t t/31-env.t ======================================= --- /trunk/t/lib/NYTProfTest.pm Sat Oct 24 08:56:24 2009 +++ /trunk/t/lib/NYTProfTest.pm Sat Nov 14 15:33:22 2009 @@ -17,7 +17,6 @@ run_command run_perl_command do_foreach_env_combination - profile_this_code ); use Devel::NYTProf::Data; @@ -189,6 +188,9 @@ print "perl5lib: $perl5lib\n"; print "nytprofcvs: $nytprofcsv\n"; } + + plan skip_all => "No '$group.*' test files and no extra_test_code" + if !...@tests and !$extra_test_code; my $tests_per_env = number_of_tests(@tests) + $extra_test_count + 1; @@ -199,22 +201,25 @@ # non-default to test override works and allow parallel testing my $profile_datafile = "nytprof_$group.out"; - $NYTPROF_TEST{file} = $profile_datafile; do_foreach_env_combination( sub { my ($env) = @_; for my $test (@tests) { + local $NYTPROF_TEST{file} = $profile_datafile; run_test($test); } if ($extra_test_code) { print("running $extra_test_count extra tests...\n"); - my $profile = eval { Devel::NYTProf::Data->new({ filename => $profile_datafile }) }; - if ($@) { - diag($@); - fail("extra tests group '$group'") foreach (1 .. $extra_test_count); - return; + my $profile; + if (@tests) { + $profile = eval { Devel::NYTProf::Data->new({ filename => $profile_datafile }) }; + if ($@) { + diag($@); + fail("extra tests group '$group'") foreach (1 .. $extra_test_count); + return; + } } $extra_test_code->($profile, $env); @@ -527,39 +532,6 @@ } -sub profile_this_code { - my %opt = @_; - - my (undef, $out_file) = tempfile('nytprof_XXXXXX', SUFFIX => 'out'); - - my @perl = ($perl, '-d:NYTProf'); - push @perl, @{ $opt{perl_opts} } if $opt{perl_opts}; - - if (my $src_file = $opt{src_file}) { - system($perl, '-d:NYTProf', $src_file) == 0 - or carp "@perl $src_file exited with an error status"; - } - elsif (my $src_code = $opt{src_code}) { - open my $fh, '|-', @perl - or croak "Can't open pipe to @perl"; - print $fh $src_code; - close $fh - or carp "@perl exited with an error status"; - } - else { - croak "Neither src_file or src_code was provided"; - } - - my $profile = Devel::NYTProf::Data->new( { - filename => $out_file, - callback => $opts{for_chunks}, - } ); - - unlink $out_file; - - return $profile; -} - 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]
