Added memory leak tests.

t/03_memory_leaks.t

@@ -0,0 +1,286 @@
+#!/usr/bin/env perl
+
+use strict;
+use warnings FATAL => "all";
+use EV;
+use AnyEvent::Blackboard;
+use BSD::Resource;
+use Devel::Leak;
+
+use Test::More;
+
+=head1 TESTS
+
+A battery of tests proving there are no memory leaks.
+
+=over 4
+
+=cut
+
+package okayer {
+    use Test::More;
+
+    sub new {
+        my ($class, %expect) = @_;
+        bless {%expect}, $class;
+    }
+
+    sub foo {
+        my ($self, $arg) = @_;
+
+        $self->{foo} eq $arg or die "$self->{foo} eq $arg";
+    }
+
+    sub bar {
+        my ($self, $arg) = @_;
+
+        $self->{bar} eq $arg or die "$self->{bar} eq $arg";
+    }
+
+    sub foobar {
+        my ($self, $foo, $bar) = @_;
+
+        $self->{foo} eq $foo &&
+        $self->{bar} eq $bar or die "both args match expect";
+    }
+}
+
+sub run_extensive_tests {
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+        my $okayer     = okayer->new(
+            foo => "foo",
+            bar => "bar",
+        );
+
+        $blackboard->watch([qw( foo bar )], [ $okayer, "foobar" ]);
+        $blackboard->watch(foo => [ $okayer, "foo" ]);
+        $blackboard->watch(bar => [ $okayer, "bar" ]);
+
+        $blackboard->put(foo => "foo");
+        $blackboard->put(bar => "bar");
+
+        $blackboard->clear;
+
+        # Put a list of keys.
+        $blackboard->put(foo => "foo", bar => "bar");
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new(default_timeout => 0.02);
+
+        my $condvar = AnyEvent->condvar;
+
+        $condvar->begin;
+
+        $blackboard->watch(foo => sub {
+                my ($foo) = @_;
+
+                !defined $foo or die "foo should be undefined as default";
+
+                $condvar->end;
+            });
+
+        $condvar->recv;
+
+        $blackboard->has("foo") or die "foo should exist";
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        my $condvar = AnyEvent->condvar;
+
+        $condvar->begin;
+
+        $blackboard->timeout(0.01, foo => "default");
+
+        $blackboard->watch(foo => sub {
+                my ($foo) = @_;
+
+                $foo eq "default" or die "foo should be defined as default";
+
+                $condvar->end;
+            });
+
+        $condvar->recv;
+
+        $blackboard->has("foo") or die "foo should be defined";
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        my $condvar = AnyEvent->condvar;
+
+        $condvar->begin;
+
+        $blackboard->timeout(0.01, foo => "default");
+
+        $blackboard->watch(foo => sub {
+                my ($foo) = @_;
+
+                $foo eq "provided" or die "foo should be defined as provided";
+
+                $condvar->end;
+            });
+
+        $blackboard->put(foo => "provided");
+
+        $condvar->recv;
+
+        $blackboard->has("foo") or die "foo should be defined";
+
+        $blackboard->clear;
+        $blackboard->hangup;
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        $blackboard->put(key => "value");
+
+        my $clone = $blackboard->clone;
+
+        $blackboard->get("key") eq $clone->get("key") or die
+        "\$blackboard and \$clone shall both have \"key\"";
+    }
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        my $value = "test";
+
+        $blackboard->put(foo => $value);
+
+        $blackboard->get("foo") eq $value or die "Value is the same";
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->build(
+            watchers => [
+                [qw( foo )] => sub { shift eq 1 or die "foo" },
+                [qw( bar )] => sub { shift eq 1 or die "bar" },
+            ],
+        )->clone;
+
+        $blackboard->put(foo => 1);
+        $blackboard->put(bar => 1);
+
+        $blackboard->clear;
+        $blackboard->hangup;
+
+        $blackboard->put(foo => 1);
+    }
+
+    {
+        my $i = 0;
+        my $blackboard = AnyEvent::Blackboard->build(
+            watchers => [
+                foo => sub { shift eq $i or die "foo" },
+            ],
+        )->clone;
+
+        $blackboard->put(foo => ++$i);
+
+        $blackboard->remove("foo");
+
+        ! $blackboard->has("foo") or die "foo should have been removed";
+
+        $blackboard->put(foo => ++$i);
+    }
+
+    {
+        my $i = 0;
+
+        my $blackboard = AnyEvent::Blackboard->build(
+            watchers => [
+                foo => sub { shift eq $i or die "foo" },
+            ],
+        )->clone;
+
+        # Make sure that we only dispatch one event.
+        $blackboard->replace(foo => ++$i) for 1 .. 2;
+
+        $blackboard->get("foo") eq 2
+            or die "get results in changed value after replace";
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new;
+
+        $blackboard->watch(foo => sub {
+                my ($blackboard) = @_;
+
+                $blackboard->put(bar => "Cause Failure");
+            }
+        );
+
+        $blackboard->watch([qw( foo bar )] => sub { "Saw event for foo bar" });
+
+        $blackboard->put(foo => $blackboard);
+
+        $blackboard->clear;
+        $blackboard->hangup;
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        $blackboard->watch(foo => sub { $blackboard->hangup });
+        $blackboard->watch(foo => sub { die "Expected hangup" });
+
+        $blackboard->put(foo => 1);
+
+        # XXX This should probably move _hangup to a public-like-named method.
+        $blackboard->_hangup or die "Blackboard was hung up";
+
+        $blackboard->hangup;
+    }
+
+    {
+        my $blackboard = AnyEvent::Blackboard->new();
+
+        $blackboard->put(blackboard => $blackboard);
+        $blackboard->weaken("blackboard");
+    }
+}
+
+=item Watcher in loop
+
+Run most of the tests from t/01_watcher.t in a loop (not using the actual test
+harness, that proved too problematic) some 20 times and verify that the
+resident footprint and number of tracked objects did not change.
+
+=cut
+
+subtest "Watcher in loop" => sub {
+    no warnings "redefine";
+
+    run_extensive_tests for 1 .. 10;
+
+    # This will shut off some of the random output from Devel::Leak;
+    close STDERR;
+
+    my $handle;
+
+    BSD::Resource::getrusage->maxrss;
+
+    my $start_count = Devel::Leak::NoteSV($handle);
+    my $resident = BSD::Resource::getrusage->maxrss;
+
+    run_extensive_tests for 1 .. 20;
+
+    my $end_count = Devel::Leak::CheckSV($handle);
+
+    is $start_count, $end_count,
+    "Object counts are the same";
+
+    is BSD::Resource::getrusage->maxrss, $resident,
+    "We don't seem to leak";
+};
+
+=back
+
+=cut
+
+done_testing;