Leaking Objects of Desire

The following takes a Catalyst or Reaction application and tests for memory leaks. One can easily adapt this to their own Catalyst or Reaction application. The first code snippet will check to see if Devel::LeakGuard::Object and Catalyst::Test modules are available for the test. If they are not the tests will be skipped, otherwise the plan is for two tests to be run.

#!/usr/bin/env perl
use strict;
use warnings;
use Test::More;

my ( $APP, $URL, $REQUEST_COUNT, $leaks );

sub BEGIN {
    $APP           = $ARGV[0] || 'TPRO';
    $URL           = $ARGV[1] || '/';
    $REQUEST_COUNT = $ARGV[2] || 10;
    $leaks         = 0;
    
    eval "use Devel::LeakGuard::Object qw(leakguard)";
    my $leakguard = ! $@;
    eval "use Catalyst::Test '$APP'";
    my $catalyst_test = ! $@;
    
    plan $leakguard && $catalyst_test
    ? ( tests => 2 )
    : ( skip_all => 
        'Devel::LeakGuard::Object and Catalyst::Test
        are needed for this test' ) ;
}

If the modules are available then we make a first request before we test for leaks. This will initialize our reference counts for things like Moose meta objects that will persist for the duration of the process.

ok( request($URL)->is_success, 'First Request' );

Now it's time to check for leaks. Here I am using the leakguard method provided by Devel::LeakGuard::Object to wrap a block of code that I want to test for leaks. I am simply making a pre-defined number of requests to the root of the application.

leakguard {
    request($URL) for 1 .. $REQUEST_COUNT;
}

In the event there is an object leak one can use the on_leak option to report on it. It takes an anonymous sub which automatically receives the report information as a HashRef.

on_leak => sub {
    my $report = shift;
    print "We got some memory leaks: \n";
    for my $pkg ( sort keys %$report ) {
        printf "%s %d %d\n", $pkg, @{ $report->{$pkg} };
    }
    $leaks++;
};

Finally, I test for leaks by examining the $leaks variable which will be incremented to 1 if there is a leak.

is( $leaks, 0, 'Object Memory Leaks' );

Shouts out to jrock (Devel::Leak::Object catalyst example idea), mst (idea to run as script using Catalyst::Test as well as the memory leak fix itself), cpan (Finding good stuff), Adam Kennedy (Devel::Leak::Object), Andy Armstrong (Devel::LeakGuard::Object).

¹ A circular reference involving the context object $c was the motivation for this article. Scalar::Util::weaken was used to break the circular reference once it was located with the help of this test script.