t/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 my $tracker = Devel::Events::Handler::ObjectTracker->new();
  15
  16 my $gen = Devel::Events::Generator::Objects->new(
  17     handler => Devel::Events::Filter::RemoveFields->new(
  18     fields => [qw/generator/], # don't need to have a ref to $gen in each event
  19     handler => $tracker,
  20 ),
  21 );
  22
  23
  24 my $app = BackPAN::Web->as_psgi_app;
  25
  26 my $run = sub {
  27     $gen->enable(); # start generating events
  28     test_psgi app => $app,
  29         client => sub {
  30             my $cb = shift;
  31             foreach my $path (qw{/ /releases /dists /authors /about}) {
  32                 for (1..1000) {
  33                     my $res = $cb->(GET $path);
  34                     ok($res->code == 200) or diag($res->code);
  35                 }
  36             }
  37         };
  38     $gen->disable();
  39 };
  40 $run->();
  41
  42 # live_objects is a Tie::RefHash::Weak hash
  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();