X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=blobdiff_plain;f=t%2Fleaktrace.t;fp=t%2Fleaktrace.t;h=3d6ac7bfeb4d00b387f1aaf7defbf1a9c5288b8d;hb=c4e00aced2b6d3754c5d3c5e20d832d986a7aed5;hp=0000000000000000000000000000000000000000;hpb=e819827c0c7ea47aef4897166f3f8a53d4bf98f0;p=catagits%2FBackPAN-Web.git

diff --git a/t/leaktrace.t b/t/leaktrace.t
new file mode 100644
index 0000000..3d6ac7b
--- /dev/null
+++ b/t/leaktrace.t
@@ -0,0 +1,57 @@
+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();