Merge branch 'hotfix_myinfo'

[catagits/BackPAN-Web.git] / t / leaktrace.t

use strict;
use warnings;
use lib 'lib';
use BackPAN::Web;
use Plack::Test;
use HTTP::Request::Common;
use Test::More;
use Devel::Cycle;
use Data::Dumper;
use Devel::Events::Handler::ObjectTracker;
use Devel::Events::Filter::RemoveFields;
use Devel::Events::Generator::Objects;

my $tracker = Devel::Events::Handler::ObjectTracker->new();

my $gen = Devel::Events::Generator::Objects->new(
    handler => Devel::Events::Filter::RemoveFields->new(
    fields => [qw/generator/], # don't need to have a ref to $gen in each event
    handler => $tracker,
),
);


my $app = BackPAN::Web->as_psgi_app;

my $run = sub {
    $gen->enable(); # start generating events
    test_psgi app => $app,
        client => sub {
            my $cb = shift;
            foreach my $path (qw{/ /releases /dists /authors /about}) {
                for (1..1000) {
                    my $res = $cb->(GET $path);
                    ok($res->code == 200) or diag($res->code);
                }
            }
        };
    $gen->disable();
};
$run->();

# live_objects is a Tie::RefHash::Weak hash

my @leaked_objects = keys %{ $tracker->live_objects };

print "leaked ", scalar(@leaked_objects), " objects\n";

foreach my $object ( @leaked_objects ) {
    print "Leaked object: $object\n";

    # the event that generated it
    #print Dumper( $object, $tracker->live_objects->{$object} );

    find_cycle( $object );
}

done_testing();