Commit | Line | Data |
b67ffc2e |
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(); |