diff --git a/t/03_memory_leaks.t b/t/03_memory_leaks.t new file mode 100644 index 0000000..ec32a8f --- /dev/null +++ b/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;