Revision: 930 Author: tim.bunce Date: Sat Dec 5 07:55:12 2009 Log: Added test for implicit utf8 SWASHNEW calls from regex (currently coredumps) Factored out code used to generate summary of subr_entry for log messages.
http://code.google.com/p/perl-devel-nytprof/source/detail?r=930 Added: /trunk/t/test81-swash.t Modified: /trunk/MANIFEST /trunk/NYTProf.xs ======================================= --- /dev/null +++ /trunk/t/test81-swash.t Sat Dec 5 07:55:12 2009 @@ -0,0 +1,38 @@ +# Tests implicit calling of utf8::SWASHNEW from unicode regex. +# +# Actually a stress test of all sorts of nasty cases including opcodes calling +# back to perl and stack switching (PUSHSTACKi(PERLSI_MAGIC)). + +use strict; +use Test::More; + +use lib qw(t/lib); +use NYTProfTest; +use Data::Dumper; + +use Devel::NYTProf::Run qw(profile_this); + +run_test_group( { + extra_options => { + start => 'begin' + compress => 1, + }, + extra_test_count => 2, + extra_test_code => sub { + my ($profile, $env) = @_; + + $profile = profile_this( + src_code => join("", <DATA>), + out_file => $env->{file}, + ); + isa_ok $profile, 'Devel::NYTProf::Data'; + }, +}); + +__DATA__ +$_ = "N\x{100}"; +chop $_; +s/ + (?: [A-Z] | [\d] )+ + (?= [\s] ) +//x; ======================================= --- /trunk/MANIFEST Fri Dec 4 12:40:49 2009 +++ /trunk/MANIFEST Sat Dec 5 07:55:12 2009 @@ -176,6 +176,7 @@ t/test80-recurs.p t/test80-recurs.rdt t/test80-recurs.t +t/test81-swash.t t/zzz.t typemap xt/test23-strevalxs.p ======================================= --- /trunk/NYTProf.xs Wed Dec 2 08:57:33 2009 +++ /trunk/NYTProf.xs Sat Dec 5 07:55:12 2009 @@ -2194,6 +2194,20 @@ static I32 subr_entry_ix = 0; #define subr_entry_ix_ptr(ix) ((ix) ? SSPTR(ix, subr_entry_t *) : NULL) + + +static char * +subr_entry_summary(pTHX_ subr_entry_t *subr_entry, int state) +{ + static char buf[80]; /* XXX */ + sprintf(buf, "(seix %d%s%d, ac%u)", + (int)subr_entry->prev_subr_entry_ix, + (state) ? "<-" : "->", + (int)subr_entry_ix, + subr_entry->already_counted + ); + return buf; +} static void @@ -2203,14 +2217,13 @@ /* ignore the typical second (fallback) destroy */ && !(subr_entry->prev_subr_entry_ix == subr_entry_ix && subr_entry->already_counted==1) ) { - logwarn("%2d << %s::%s done (seix %d<-%d, ac%u)\n", + logwarn("%2d << %s::%s done %s\n", subr_entry->subr_prof_depth, subr_entry->called_subpkg_pv, (subr_entry->called_subnam_sv && SvOK(subr_entry->called_subnam_sv)) ? SvPV_nolen(subr_entry->called_subnam_sv) : "?", - (int)subr_entry->prev_subr_entry_ix, (int)subr_entry_ix, - subr_entry->already_counted); + subr_entry_summary(aTHX_ subr_entry, 1)); } if (subr_entry->caller_subnam_sv) { sv_free(subr_entry->caller_subnam_sv); @@ -2655,13 +2668,14 @@ } if (trace_level >= 4) { - logwarn("%2d >> %s at %u:%d from %s::%s %s (seix %d->%d)\n", + logwarn("%2d >> %s at %u:%d from %s::%s %s %s\n", subr_entry->subr_prof_depth, PL_op_name[op_type], subr_entry->caller_fid, subr_entry->caller_line, subr_entry->caller_subpkg_pv, SvPV_nolen(subr_entry->caller_subnam_sv), - found_caller_by, (int)prev_subr_entry_ix, (int)subr_entry_ix + found_caller_by, + subr_entry_summary(aTHX_ subr_entry, 0) ); } @@ -2816,9 +2830,15 @@ * or Scope::Upper's unwind() */ if (subr_entry->already_counted) { - assert(subr_entry->already_counted < 3); if (trace_level >= 9) - logwarn("%2d -- already counted\n", subr_entry->subr_prof_depth); + logwarn("%2d -- %s::%s already counted %s\n", + subr_entry->subr_prof_depth, + subr_entry->called_subpkg_pv, + (subr_entry->called_subnam_sv && SvOK(subr_entry->called_subnam_sv)) + ? SvPV_nolen(subr_entry->called_subnam_sv) + : "?", + subr_entry_summary(aTHX_ subr_entry, 1)); + assert(subr_entry->already_counted < 3); goto skip_sub_profile; } -- 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]
