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;
  
  
  

Reply via email to