stas 2004/01/24 18:42:50
Modified: t/conf modperl_extra.pl Log: add a framework for testing for memory leaks in our tests Revision Changes Path 1.40 +76 -0 modperl-2.0/t/conf/modperl_extra.pl Index: modperl_extra.pl =================================================================== RCS file: /home/cvs/modperl-2.0/t/conf/modperl_extra.pl,v retrieving revision 1.39 retrieving revision 1.40 diff -u -u -r1.39 -r1.40 --- modperl_extra.pl 22 Jan 2004 23:25:54 -0000 1.39 +++ modperl_extra.pl 25 Jan 2004 02:42:50 -0000 1.40 @@ -272,5 +272,81 @@ } } +package ModPerl::TestMemoryLeak; + +# handy functions to measure memory leaks. since it measures the total +# memory size of the process and not just perl leaks, you get your +# C/XS leaks discovered too +# +# For example to test TestAPR::Pool::handler for leaks, add to its +# top: +# +# ModPerl::TestMemoryLeak::start(); +# +# and just before returning from the handler add: +# +# ModPerl::TestMemoryLeak::end(); +# +# now start the server with only worker server +# +# % t/TEST -maxclients 1 -start +# +# of course use maxclients 1 only if your test be handled with one +# client, e.g. proxy tests need at least two clients. +# +# Now repeat the same test several times (more than 3) +# +# % t/TEST -run apr/pool -times=10 +# +# t/logs/error_log will include something like: +# +# size vsize resident share rss +# 196k 132k 196k 0M 196k +# 104k 132k 104k 0M 104k +# 16k 0k 16k 0k 16k +# 0k 0k 0k 0k 0k +# 0k 0k 0k 0k 0k +# 0k 0k 0k 0k 0k +# +# as you can see the first few runs were allocating memory, but the +# following runs should consume no more memory. The leak tester measures +# the extra memory allocated by the process since the last test. Notice +# that perl and apr pools usually allocate more memory than they +# need, so some leaks can be hard to see, unless many tests (like a +# hundred) were run. + +use warnings; +use strict; + +use constant HAS_GTOP => eval { require GTop }; + +my $gtop = HAS_GTOP ? GTop->new : undef; +my @attrs = qw(size vsize resident share rss); +my $format = "%8s %8s %8s %8s %8s\n"; + +my %before; + +sub start { + + die "No GTop avaible, bailing out" unless HAS_GTOP; + + unless (keys %before) { + my $before = $gtop->proc_mem($$); + %before = map { $_ => $before->$_() } @attrs; + # print the header once + warn sprintf $format, @attrs; + } +} + +sub end { + + die "No GTop avaible, bailing out" unless HAS_GTOP; + + my $after = $gtop->proc_mem($$); + my %after = map {$_ => $after->$_()} @attrs; + warn sprintf $format, + map GTop::size_string($after{$_} - $before{$_}), @attrs; + %before = %after; +} 1;