t/01-leaktrace.t

   1 use strict;
   2 use warnings;
   3 use lib 'lib';
   4 use BackPAN::Web;
   5 use Plack::Test;
   6 use HTTP::Request::Common;
   7 use Test::More;
   8 use Devel::Cycle;
   9 use Data::Dumper;
  10 use Devel::Events::Handler::ObjectTracker;
  11 use Devel::Events::Filter::RemoveFields;
  12 use Devel::Events::Generator::Objects;
  13
  14 $ENV{PLACK_ENV} = 'test';
  15
  16 my $tracker = Devel::Events::Handler::ObjectTracker->new();
  17
  18 my $gen = Devel::Events::Generator::Objects->new(
  19     handler => Devel::Events::Filter::RemoveFields->new(
  20     fields => [qw/generator/],
  21     handler => $tracker,
  22 ),
  23 );
  24
  25
  26 my $app = BackPAN::Web->as_psgi_app;
  27
  28 my $run = sub {
  29     $gen->enable();
  30     test_psgi app => $app,
  31         client => sub {
  32             my $cb = shift;
  33             foreach my $path (qw{/ /releases /dists /authors /about}) {
  34                 for (1..1000) {
  35                     my $res = $cb->(GET $path);
  36                     ok($res->code == 200) or diag($res->code);
  37                 }
  38             }
  39         };
  40     $gen->disable();
  41 };
  42 $run->();
  43
  44 my @leaked_objects = keys %{ $tracker->live_objects };
  45
  46 print "leaked ", scalar(@leaked_objects), " objects\n";
  47
  48 foreach my $object ( @leaked_objects ) {
  49     print "Leaked object: $object\n";
  50
  51     # the event that generated it
  52     #print Dumper( $object, $tracker->live_objects->{$object} );
  53
  54     find_cycle( $object );
  55 }
  56
  57 done_testing();