"Fossies" - the Fresh Open Source Software Archive

Member "mod_perl-2.0.11/t/lib/TestCommon/MemoryLeak.pm" (5 Oct 2019, 2758 Bytes) of package /linux/www/apache_httpd_modules/mod_perl-2.0.11.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file. See also the last Fossies "Diffs" side-by-side code changes report for "MemoryLeak.pm": 2.0.8_vs_2.0.9.

    1 # please insert nothing before this line: -*- mode: cperl; cperl-indent-level: 4; cperl-continued-statement-offset: 4; indent-tabs-mode: nil -*-
    2 package TestCommon::MemoryLeak;
    3 
    4 # handy functions to measure memory leaks. since it measures the total
    5 # memory size of the process and not just perl leaks, you get your
    6 # C/XS leaks discovered too
    7 #
    8 # For example to test TestAPR::Pool::handler for leaks, add to its
    9 # top:
   10 #
   11 #  TestCommon::MemoryLeak::start();
   12 #
   13 # and just before returning from the handler add:
   14 #
   15 #  TestCommon::MemoryLeak::end();
   16 #
   17 # now start the server with only worker server
   18 #
   19 #  % t/TEST -maxclients 1 -start
   20 #
   21 # of course use maxclients 1 only if your test be handled with one
   22 # client, e.g. proxy tests need at least two clients.
   23 #
   24 # Now repeat the same test several times (more than 3)
   25 #
   26 # % t/TEST -run apr/pool -times=10
   27 #
   28 # t/logs/error_log will include something like:
   29 #
   30 #    size    vsize resident    share      rss
   31 #    196k     132k     196k       0M     196k
   32 #    104k     132k     104k       0M     104k
   33 #     16k       0k      16k       0k      16k
   34 #      0k       0k       0k       0k       0k
   35 #      0k       0k       0k       0k       0k
   36 #      0k       0k       0k       0k       0k
   37 #
   38 # as you can see the first few runs were allocating memory, but the
   39 # following runs should consume no more memory. The leak tester measures
   40 # the extra memory allocated by the process since the last test. Notice
   41 # that perl and apr pools usually allocate more memory than they
   42 # need, so some leaks can be hard to see, unless many tests (like a
   43 # hundred) were run.
   44 
   45 use strict;
   46 use warnings FATAL => 'all';
   47 
   48 # XXX: as of 5.8.4 when spawning ithreads we get an annoying
   49 #  Attempt to free unreferenced scalar ... perlbug #24660
   50 # because of $gtop's CLONE'd object, so pretend that we have no gtop
   51 # for now if perl is threaded
   52 # GTop v0.12 is the first version that will work under threaded mpms
   53 use Config;
   54 use constant HAS_GTOP => eval { !$Config{useithreads} &&
   55                                 require GTop && GTop->VERSION >= 0.12 };
   56 
   57 my $gtop = HAS_GTOP ? GTop->new : undef;
   58 my @attrs = qw(size vsize resident share rss);
   59 my $format = "%8s %8s %8s %8s %8s\n";
   60 
   61 my %before;
   62 
   63 sub start {
   64 
   65     die "No GTop avaible, bailing out" unless HAS_GTOP;
   66 
   67     unless (keys %before) {
   68         my $before = $gtop->proc_mem($$);
   69         %before = map { $_ => $before->$_() } @attrs;
   70         # print the header once
   71         warn sprintf $format, @attrs;
   72     }
   73 }
   74 
   75 sub end {
   76 
   77     die "No GTop avaible, bailing out" unless HAS_GTOP;
   78 
   79     my $after = $gtop->proc_mem($$);
   80     my %after = map {$_ => $after->$_()} @attrs;
   81     warn sprintf $format,
   82         map GTop::size_string($after{$_} - $before{$_}), @attrs;
   83     %before = %after;
   84 }
   85 
   86 1;
   87 
   88 __END__