Revision: 950 Author: tim.bunce Date: Tue Dec 15 14:54:06 2009 Log: Added extra test that tickles an old perl bug. Currently fails.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=950 Added: /trunk/t/test82-stress.t Modified: /trunk/MANIFEST ======================================= --- /dev/null +++ /trunk/t/test82-stress.t Tue Dec 15 14:54:06 2009 @@ -0,0 +1,55 @@ +# Stress tests + +use strict; +use Test::More; + +use lib qw(t/lib); +use NYTProfTest; +use Data::Dumper; + +use Devel::NYTProf::Run qw(profile_this); + +my $src_code = join("", <DATA>); + +run_test_group( { + extra_options => { + compress => 1, + savesrc => 1, + }, + extra_test_code => sub { + my ($profile, $env) = @_; + + $profile = profile_this( + src_code => $src_code, + out_file => $env->{file}, + ); + isa_ok $profile, 'Devel::NYTProf::Data'; + # check if data truncated e.g. due to assertion failure + ok $profile->{attribute}{complete}; + + ok my $subs = $profile->subs_defined_in_file(1); + ok $subs->{'main::pass'}->calls; + + }, + extra_test_count => 3, +}); + +__DATA__ + +# test for old perl bug 20010515.004 that NYTProf tickled into life +# http://markmail.org/message/3q6q2on3gl6fzdhv +# http://markmail.org/message/b7qnerilkusauydf +# based on test in perl's t/run/fresh_perl.t +my @h = 1 .. 10; +sub bad { + undef @h; + open BUF, '>', \my $stdout_buf or die "Can't open STDOUT: $!"; + # is the bug is tickled this will print something like + # HASH(0x82acc0)ARRAY(0x821b60)ARRAY(0x812f10)HASH(0x8133f0)HASH(0x8133f0)ARRAY(0x821b60)00 + print BUF for @_; # this line is very sensitive to changes + die "\...@_ affected by NYTProf" if $stdout_buf; + close BUF; +} +bad(@h); + +sub pass { }; pass(); # flag successful completion ======================================= --- /trunk/MANIFEST Sat Dec 5 07:55:12 2009 +++ /trunk/MANIFEST Tue Dec 15 14:54:06 2009 @@ -177,6 +177,7 @@ t/test80-recurs.rdt t/test80-recurs.t t/test81-swash.t +t/test82-stress.t t/zzz.t typemap xt/test23-strevalxs.p -- 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]
