Update with latest fixes

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

diff --git a/t/leaktrace.t b/t/leaktrace.t
new file mode 100644 (file)
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();