r17921 - in /trunk/libdevel-profile-perl: ./ CHANGES INSTALL MANIFEST META.yml Makefile.PL Profile.pm README t/ t/test1.t t/test2.t t/test3.t t/test4.t t/test5.t
joeyh at users.alioth.debian.org
joeyh at users.alioth.debian.org
Fri Mar 21 20:07:50 UTC 2008
Author: joeyh
Date: Fri Mar 21 20:07:49 2008
New Revision: 17921
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=17921
Log:
initial import of upstream source
Added:
trunk/libdevel-profile-perl/
trunk/libdevel-profile-perl/CHANGES
trunk/libdevel-profile-perl/INSTALL
trunk/libdevel-profile-perl/MANIFEST
trunk/libdevel-profile-perl/META.yml
trunk/libdevel-profile-perl/Makefile.PL
trunk/libdevel-profile-perl/Profile.pm
trunk/libdevel-profile-perl/README
trunk/libdevel-profile-perl/t/
trunk/libdevel-profile-perl/t/test1.t
trunk/libdevel-profile-perl/t/test2.t
trunk/libdevel-profile-perl/t/test3.t
trunk/libdevel-profile-perl/t/test4.t
trunk/libdevel-profile-perl/t/test5.t
Added: trunk/libdevel-profile-perl/CHANGES
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/CHANGES?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/CHANGES (added)
+++ trunk/libdevel-profile-perl/CHANGES Fri Mar 21 20:07:49 2008
@@ -1,0 +1,23 @@
+
+1.05 [2007 Mar 07]
+ documentation changes as per phl.pm recommendation
+
+1.04 [2004 Apr 29]
+ regex issue
+
+1.03 [2003 Dec 8]
+ changed output format of <anon> lines
+ better time calculation for unfinished subs
+
+1.02 [2003 Jul 9]
+ handle void context
+ fix periodic save
+
+1.01 [2003 Apr 15]
+ corrected documentation
+ added test scripts
+ fixed 5.8.0 issue
+ fixed exception issue
+
+1.00 [2003 Apr 13]
+ initial public release
Added: trunk/libdevel-profile-perl/INSTALL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/INSTALL?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/INSTALL (added)
+++ trunk/libdevel-profile-perl/INSTALL Fri Mar 21 20:07:49 2008
@@ -1,0 +1,28 @@
+
+Installing:
+
+ 1. verify that you have the prerequisites installed
+
+ + perl
+ perl is required for both this module and the perl program you wish
+ to profile. the software has been tested with 5.6.1 and should work
+ with anything more recent, and maybe less recent, as well.
+ Find perl at www.perl.org
+
+ + Time::HiRes
+ is required in order to perform timing calculations.
+ it ships with recent versions of perl, or can be
+ downloaded from CPAN
+
+ 2. unbundle the tarball
+
+ 3. run 'perl Makefile.PL'
+
+ 4. run 'make'
+
+ 5. run 'make install'
+
+ 6. run 'perldoc Devel::Profile'
+
+ 7. you are finished, sing a happy song, or, optionally, send in a bug report
+
Added: trunk/libdevel-profile-perl/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/MANIFEST?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/MANIFEST (added)
+++ trunk/libdevel-profile-perl/MANIFEST Fri Mar 21 20:07:49 2008
@@ -1,0 +1,12 @@
+MANIFEST
+README
+INSTALL
+CHANGES
+Makefile.PL
+Profile.pm
+t/test1.t
+t/test2.t
+t/test3.t
+t/test4.t
+t/test5.t
+META.yml Module meta-data (added by MakeMaker)
Added: trunk/libdevel-profile-perl/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/META.yml?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/META.yml (added)
+++ trunk/libdevel-profile-perl/META.yml Fri Mar 21 20:07:49 2008
@@ -1,0 +1,11 @@
+# http://module-build.sourceforge.net/META-spec.html
+#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
+name: Devel-Profile
+version: 1.05
+version_from: Profile.pm
+installdirs: site
+requires:
+ Time::HiRes: 0
+
+distribution_type: module
+generated_by: ExtUtils::MakeMaker version 6.30
Added: trunk/libdevel-profile-perl/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/Makefile.PL?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/Makefile.PL (added)
+++ trunk/libdevel-profile-perl/Makefile.PL Fri Mar 21 20:07:49 2008
@@ -1,0 +1,8 @@
+use ExtUtils::MakeMaker;
+WriteMakefile(
+ NAME => 'Devel::Profile',
+ VERSION_FROM => 'Profile.pm',
+ ABSTRACT_FROM => 'Profile.pm',
+ AUTHOR => 'Jeff Weisberg <http://www.tcp4me.com/>',
+ PREREQ_PM => {Time::HiRes => 0},
+);
Added: trunk/libdevel-profile-perl/Profile.pm
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/Profile.pm?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/Profile.pm (added)
+++ trunk/libdevel-profile-perl/Profile.pm Fri Mar 21 20:07:49 2008
@@ -1,0 +1,480 @@
+# -*- perl -*-
+
+# Copyright (c) 2002 by Jeff Weisberg
+# Author: Jeff Weisberg <jaw+profile @ tcp4me.com>
+# Date: 2002-Jun-21 22:19 (EDT)
+# Function: code profiler
+#
+# $Id: Profile.pm,v 1.22 2007/03/08 02:25:42 jaw Exp $
+
+# Dost thou love life? Then do not squander time
+# -- Benjamin Franklin
+
+# start as:
+# env PERL5DB='BEGIN{require "src/Profile.pm"}' perl -d program.pl
+# or: perl -d:Profile program.pl
+# data gets saved in 'prof.out'
+
+# motivation:
+# Devel::DProf appears to have issues. when it is used
+# 9 times out of 10 it produces output that is unusable by dprofpp (even with -F)
+# the statistics are often obviously wrong
+# it causes crashage
+# of course, this code isn't really any better....
+
+=head1 NAME
+
+Devel::Profile - tell me why my perl program runs so slowly
+
+=head1 SYNOPSIS
+
+ perl -d:Profile program.pl
+ less prof.out
+
+=head1 DESCRIPTION
+
+The Devel::Profile package is a Perl code profiler.
+This will collect information on the execution time of a Perl script and of the subs in that script.
+This information can be used to determine which subroutines are using the most time and which
+subroutines are being called most often.
+
+To profile a Perl script, run the perl interpreter with the -d debugging switch.
+The profiler uses the debugging hooks.
+So to profile script test.pl the following command should be used:
+
+ perl -d:Profile test.pl
+
+When the script terminates (or periodicly while running, see ENVIRONMENT) the profiler will dump
+the profile information to a file called F<prof.out>. This file is human-readable, no
+additional tool is required to read it.
+
+Note: Statistics are kept per sub, not per line.
+
+=head1 ENVIRONMENT
+
+=over 4
+
+=item C<PERL_PROFILE_SAVETIME>
+
+How often to save profile data while running, in seconds, 0 to save only at exit.
+The default is every 2 minutes.
+
+=item C<PERL_PROFILE_FILENAME>
+
+Filename to save profile data to, default is F<prof.out>
+
+=item C<PERL_PROFILE_DONT_OTHER>
+
+Time spent running code not in 'subs' (such as naked code in main) won\'t
+get accounted for in the normal manner. By default, we account for this time
+in the sub '<other>'. With this variable set, we leave it as 'missing' time.
+This reduces the effective runtime of the program, and the calculated percentages.
+
+=back
+
+=cut
+ ;
+# more POD at end
+
+package Devel::Profile;
+$VERSION = "1.05";
+
+package DB;
+BEGIN {
+ sub DB {}
+ require Time::HiRes; Time::HiRes->import('time');
+}
+
+my $t0 = time(); # start time
+my $tsav = $t0; # time of last save
+my $tacc = 0; # total time accumulated
+my $tacc0 = 0; # total time accumulated at start (or reset)
+my $call = 0; # total number of calls
+my $except = 0; # total number of exceptions handled (est)
+my $saving = 0; # save in progress
+my $tprof_save = 0; # time spent saving data
+my %prof_calls = (); # number of calls per sub
+my %prof_times = (); # total time per sub
+my %prof_flags = (); # flags
+my @prof_stack = (); # call stack, to account for subs that haven't returned
+my $want_reset = 0; # reset request pending
+my $prof_pid = $$; # process id
+
+my $TSAVE = defined($ENV{PERL_PROFILE_SAVETIME}) ? $ENV{PERL_PROFILE_SAVETIME} : 120;
+my $NCALOOP = 1000;
+
+$SIG{USR2} = \&reset;
+
+sub sub {
+
+ my $ti = time(); # wall time at start
+ # save first, keeps timing calculations simpler
+ if( !$saving && $TSAVE && ($ti - $tsav) > $TSAVE ){
+ save();
+ $ti = time(); # update to account for save
+ }
+
+ my $st = $tacc; # accum time at start
+ my $sx = $sub;
+ if( ref $sx ){
+ my @c = caller;
+ # was 0, now 1
+ # nb: @c = (pkg, file, line, ...)
+ $sx = "<anon>:$c[1]:$c[2]";
+ }
+ push @prof_stack, [$sx, $ti, $st];
+ my $ss = @prof_stack;
+
+ my( $wa, $r, @r );
+ $wa = wantarray;
+ if( $wa ){
+ @r = &$sub;
+ }elsif( defined $wa ){
+ $r = &$sub;
+ }else{
+ &$sub;
+ }
+
+ if( $ss < @prof_stack ){
+ # we took an exception - account for aborted subs
+ # print STDERR "exception detected!\n";
+
+ while( $ss < @prof_stack ){
+ my $sk = pop @prof_stack;
+ my $sn = $sk->[0];
+ my $t = time() - $sk->[1] - ($tacc - $sk->[2]);
+ $tacc += $t;
+ $prof_times{$sn} += $t;
+ $prof_calls{$sn} ++;
+ $prof_flags{$sn} |= 2;
+ $call ++;
+ }
+ $except++;
+ $prof_flags{$sx} |= 4;
+ }
+
+ if( pop @prof_stack ){ # do not update if reset
+ my $t = time() - $ti # total time of called sub
+ - ($tacc - $st); # minus time of subs it called
+ $tacc += $t;
+ $prof_times{$sx} += $t; # We take no note of time
+ $prof_calls{$sx} ++; # But from its loss
+ $call ++; # -- Edward Young, Night Thoughts
+ }
+
+ if( $wa ){
+ @r;
+ }else{
+ $r;
+ }
+}
+
+sub save {
+ return if $saving;
+ unless( $call ){
+ # nothing to report
+ $tsav = time();
+ return;
+ }
+ $saving = 1;
+
+ # only parent process
+ return unless $$ == $prof_pid;
+
+ my $tnow = time();
+ my $ttwall = $tnow - $t0;
+ my $f = $ENV{PERL_PROFILE_FILENAME} || 'prof.out';
+ open( F, "> $f" ) || die "open failed, $f $!\n";
+
+ # calc. an estimate of Tadj (overhead of DB::sub)
+ # Tadj = 3/4 of the fastest sub
+ my $tadj;
+ foreach my $s (keys %prof_times){
+ next unless $prof_calls{$s} >= 10;
+ my $t = $prof_times{$s} / $prof_calls{$s};
+ $tadj = $t if !defined($tadj) || $t < $tadj;
+ }
+ $tadj *= .75;
+
+ # adjust run times
+ my( %times, %calls, %flags );
+ %calls = %prof_calls;
+ %flags = %prof_flags;
+ foreach (keys %prof_times){
+ $times{$_} = $prof_times{$_} - $tadj * $prof_calls{$_};
+ }
+
+ # calculate profiling overhead, and hide our droppings
+ my $calladj = 0;
+ my $tprof = $tadj * $call + $times{Devel::Profile::__db_calibrate_adj} + $tprof_save;
+ delete $times{Devel::Profile::__db_calibrate_adj};
+ $calladj = 0 - $prof_calls{Devel::Profile::__db_calibrate_adj};
+
+ # calc time of subs that never finished, by unwinding the saved call stack
+ my $xend = $tnow;
+ my $xacc = $tacc;
+ foreach my $sk (reverse @prof_stack){
+ # since it didn't return, we only adjust by half of Tadj
+ my $sn = $sk->[0];
+ my $t = $xend - $sk->[1] - ($xacc - $sk->[2]);
+ $times{ $sn } += $t - $tadj/2;
+ $calls{ $sn } ++;
+ # and since we are using different math, and a different estimate of
+ # the profiling overhead, we display a flag alerting the user
+ $flags{ $sn } |= 2;
+ $xend = $sk->[1];
+ $xacc = $sk->[2];
+ $tprof += $tadj/2;
+ $calladj ++;
+ }
+
+ # calc time for other: "naked" code, ???
+ unless( $ENV{PERL_PROFILE_DONT_OTHER} ){
+ my $tnaked = $xend - $t0 - ($tacc - $tacc0);
+ if( $tnaked < 0 ){
+ # dang! mis-estimates threw our numbers off by too much
+ # print STDERR "dang: $tnaked = $xend - $t0 - ($tacc - $tacc0)\n";
+ $tnaked = 0;
+ }
+ $times{'<other>'} = $tnaked;
+ $calls{'<other>'} = 0;
+ $flags{'<other>'} |= 1;
+ }
+
+ # total run time of program
+ my $tt;
+ foreach (values %times){$tt += $_}
+
+ # dreams are very curious and unaccountable things
+ # -- Homer, Odyssey
+ # unaccounted for "missing" time
+ my $tmissing = $ttwall - $tt - $tprof;
+
+ printf F "time elapsed (wall): %.4f\n", $ttwall;
+ printf F "time running program: %.4f (%.2f%%)\n", $tt, 100 * $tt / $ttwall;
+ printf F "time profiling (est.): %.4f (%.2f%%)\n", $tprof, 100 * $tprof / $ttwall;
+ printf F "missing time: %.4f (%.2f%%)\n", $tmissing, 100 * $tmissing / $ttwall
+ if( $tmissing / $ttwall > 0.0001 );
+ print F "number of calls: ", $call + $calladj, "\n";
+ print F "number of exceptions: $except\n" if $except;
+
+ print F "\n%Time Sec. \#calls sec/call F name\n";
+ foreach my $s (sort {$times{$b} <=> $times{$a}} keys %times){
+ my $c = $calls{$s};
+ my $t = $times{$s};
+ my $tpc = $t / ($c || 1);
+ my $pct = $t * 100 / $tt;
+ my $sp = $s;
+
+ if( substr($sp, 0, 6) eq '<anon>' ){
+ # make prettier
+ if( length($sp) > 35 ){
+ $sp = '<anon>:...' . substr($sp, -28, 28);
+ }
+ }
+
+ printf F "%5.2f %9.4f %7d %9.6f %2s $sp\n",
+ $pct, $t, $c, $tpc, F($flags{$s});
+ }
+ close F;
+
+ # Let every man be master of his time
+ # -- Shakespeare, Macbeth
+ # account for time spent saving data
+ $tsav = time();
+ my $telap = $tsav - $tnow;
+ $tacc += $telap;
+ $tprof_save += $telap;
+
+ $saving = 0;
+ reset() if $want_reset;
+}
+
+# 1=> *, 2=>?, 4=>x
+sub F {
+ ('', '*', '?', '?*', 'x', 'x*', 'x?', 'X?')[shift || 0];
+}
+
+sub reset {
+ if( $saving ){
+ $want_reset = 1;
+ return;
+ }
+ save();
+ $t0 = time();
+ $tacc0 = $tacc;
+ $call = 0;
+ $except = 0;
+ %prof_calls = ();
+ %prof_times = ();
+ %prof_flags = ();
+ @prof_stack = ();
+ $want_reset = 0;
+}
+
+END {
+ save();
+}
+
+################################################################
+package Devel::Profile;
+use strict;
+sub __db_calibrate_adj {
+ my $x = shift;
+}
+for my $i (1..$NCALOOP){
+ __db_calibrate_adj();
+}
+
+################################################################
+
+# o When execution of the program reaches a subroutine
+# call, a call to "&DB::sub"(args) is made instead, with
+# "$DB::sub" holding the name of the called subroutine.
+# This doesn't happen if the subroutine was compiled in
+# the "DB" package.)
+
+################################################################
+
+=head1 OUTPUT FORMAT
+
+example ouput:
+
+ time elapsed (wall): 86.8212
+ time running program: 65.7657 (75.75%)
+ time profiling (est.): 21.0556 (24.25%)
+ number of calls: 647248
+
+ %Time Sec. #calls sec/call F name
+ 31.74 20.8770 2306 0.009053 Configable::init_from_config
+ 20.09 13.2116 144638 0.000091 Configable::init_field_from_config
+ 17.49 11.5043 297997 0.000039 Configable::has_attr
+ 8.22 5.4028 312 0.017317 MonEl::recycle
+ 7.54 4.9570 64239 0.000077 Configable::inherit
+ 5.02 3.3042 101289 0.000033 MonEl::unique
+ [...]
+
+This is a small summary, followed by one line per sub.
+
+=over 4
+
+=item time elapsed (wall)
+
+This is the total time elapsed.
+
+=item time running program
+
+This is the amount of time spent running your program.
+
+=item time profiling
+
+This is the amount of time wasted due to profiler overhead.
+
+=item number of calls
+
+This is the total number of subroutine calls your program made.
+
+=back
+
+Followed by one line per subroutine.
+
+=over 4
+
+=item name
+
+The name of the subroutine.
+
+=item %Time
+
+The percentage of the total program runtime used by this subroutine.
+
+=item Sec.
+
+The total number of seconds used by this subroutine.
+
+=item #calls
+
+The number of times this subroutine was called.
+
+=item sec/call
+
+The average number of seconds this subroutines takes each time it is called.
+
+=item F
+
+Flags.
+
+=over 4
+
+=item C<*>
+
+pseudo-function to account for otherwise unacounted for time.
+
+=item C<?>
+
+At least one call of this subroutine did not return (typically because
+of an C<exit>, or C<die>). The statistics for it may be slightly off.
+
+=item C<x>
+
+At least one call of this subroutine trapped an exception.
+The statistics for it may be slightly off.
+
+=back
+
+=back
+
+=head1 LONG RUNNING PROGRAMS
+
+This module was written so that the author could profile a large long-running
+(daemon) program. Since normally, this program never exited, saving profiling
+data only at program exit was not an interesting option. This module will save
+profiling data periodically based on $PERL_PROFILE_SAVETIME, or the program
+being profiled can call C<DB::save()> at any time. This allows you to watch
+your profiling data while the program is running.
+
+The above program also had a very large startup phase (reading config files,
+building data structures, etc), the author wanted to see profiling data
+for the startup phase, and for the running phase seperately. The running
+program can call C<DB::reset()> to save the profiling data and reset the
+statistics. Once reset, only "stuff" that happens from that point on will be
+reflected in the profile data file.
+
+By default, reset is attached to the signal handler for C<SIGUSR2>.
+Using a perl built with "safe signal handling" (5.8.0 and higher),
+you may safely send this signal to control profiling.
+
+=head1 BUT I WANT INCLUSIVE TIMES NOT EXCLUSIVE TIMES
+
+Please see the spin-off module Devel::DProfLB.
+
+=head1 BUGS
+
+Some buggy XS based perl modules can behave erroneously when
+run under the perl debugger. Since Devel::Profile uses the perl
+debugger interfaces, these modules will also behave erroneously
+when being profiled.
+
+There are no known bugs in this module.
+
+=head1 LICENSE
+
+This software may be copied and distributed under the terms
+found in the Perl "Artistic License".
+
+A copy of the "Artistic License" may be found in the standard
+Perl distribution.
+
+=head1 SEE ALSO
+
+ Yellowstone National Park.
+ Devel::DProfLB
+
+=head1 AUTHOR
+
+Jeff Weisberg - http://www.tcp4me.com/
+
+=cut
+ ;
+
+1;
Added: trunk/libdevel-profile-perl/README
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/README?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/README (added)
+++ trunk/libdevel-profile-perl/README Fri Mar 21 20:07:49 2008
@@ -1,0 +1,22 @@
+SUMMARY:
+ Devel::Profile is used to determine why your perl program runs so slowly.
+
+INSTALLATION:
+ see the file INSTALL
+
+COPYRIGHT:
+ see the copyright notice in Profile.pm
+
+LICENSE INFORMATION:
+ This software may be copied and distributed under the terms
+ found in the Perl "Artistic License".
+
+ A copy of the "Artistic License" may be found in the standard
+ Perl distribution.
+
+DOCUMENTATION:
+ see the pod in Profile.pm
+
+AUTHOR:
+ Jeff Weisberg - http://www.tcp4me.com/
+
Added: trunk/libdevel-profile-perl/t/test1.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/t/test1.t?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/t/test1.t (added)
+++ trunk/libdevel-profile-perl/t/test1.t Fri Mar 21 20:07:49 2008
@@ -1,0 +1,4 @@
+# -*- perl -*-
+
+use Devel::Profile;
+print "1..1\nok 1\n";
Added: trunk/libdevel-profile-perl/t/test2.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/t/test2.t?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/t/test2.t (added)
+++ trunk/libdevel-profile-perl/t/test2.t Fri Mar 21 20:07:49 2008
@@ -1,0 +1,12 @@
+#!perl -d:Profile
+# -*- perl -*-
+
+sub foo {}
+sub bar {}
+sub baz {}
+
+foo();
+bar();
+baz();
+
+print "1..1\nok 1\n";
Added: trunk/libdevel-profile-perl/t/test3.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/t/test3.t?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/t/test3.t (added)
+++ trunk/libdevel-profile-perl/t/test3.t Fri Mar 21 20:07:49 2008
@@ -1,0 +1,37 @@
+# -*- perl -*-
+
+print "1..2\n";
+# read the prof.out created by test2.t
+open( F, "prof.out" ) || die "cannot open prof.out: $!\n";
+
+# skip top header
+while( <F> ){ last if /^\s*$/ }
+
+# skip info header
+scalar <F>;
+
+my $pt = 0;
+my %f;
+while( <F> ){
+ chop;
+ my @x = split;
+
+ $pt += $x[0];
+ $f{$x[-1]} = 1;
+}
+close F;
+unlink "prof.out";
+
+# make sure percents are ok
+if( $pt < 98 || $pt > 102 ){
+ print "not ok 1\n";
+}else{
+ print "ok 1\n";
+}
+
+# make sure we saw all 3 funcs
+if( $f{main::foo} && $f{main::bar} && $f{main::baz} ){
+ print "ok 2\n";
+}else{
+ print "not ok 2\n";
+}
Added: trunk/libdevel-profile-perl/t/test4.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/t/test4.t?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/t/test4.t (added)
+++ trunk/libdevel-profile-perl/t/test4.t Fri Mar 21 20:07:49 2008
@@ -1,0 +1,23 @@
+#!perl -d:Profile
+# -*- perl -*-
+
+sub foo {
+ sleep 1;
+ die {};
+}
+
+sub bar {
+ sleep 1;
+ foo();
+ sleep 1; # this never happens
+}
+
+sub baz {
+ sleep 1;
+ eval { bar() };
+ sleep 1; # because of the exception, this gets accounted for in foo
+}
+
+baz();
+
+print "1..1\nok 1\n";
Added: trunk/libdevel-profile-perl/t/test5.t
URL: http://svn.debian.org/wsvn/pkg-perl/trunk/libdevel-profile-perl/t/test5.t?rev=17921&op=file
==============================================================================
--- trunk/libdevel-profile-perl/t/test5.t (added)
+++ trunk/libdevel-profile-perl/t/test5.t Fri Mar 21 20:07:49 2008
@@ -1,0 +1,37 @@
+# -*- perl -*-
+
+print "1..2\n";
+# read the prof.out created by test4.t
+open( F, "prof.out" ) || die "cannot open prof.out: $!\n";
+
+# skip top header
+while( <F> ){ last if /^\s*$/ }
+
+# skip info header
+scalar <F>;
+
+my $pt = 0;
+my %f;
+while( <F> ){
+ chop;
+ my @x = split;
+
+ $pt += $x[0];
+ $f{$x[-1]} = 1;
+}
+close F;
+unlink "prof.out";
+
+# make sure percents are ok
+if( $pt < 98 || $pt > 102 ){
+ print "not ok 1\n";
+}else{
+ print "ok 1\n";
+}
+
+# make sure we saw all 3 funcs
+if( $f{main::foo} && $f{main::bar} && $f{main::baz} ){
+ print "ok 2\n";
+}else{
+ print "not ok 2\n";
+}
More information about the Pkg-perl-cvs-commits
mailing list