| Subject: | T::MO objects leak under certain circumstances |
There are two problems here
1) T::MO uses an "Inside Out" technique to record certain instance data, but does not declare
a destructor to free that data.
2) Due to the nature of perl method invocation, the first argument to mock object method
invocations is the mock object reference itself. If the mock method has logging enabled, this
reference is retained in the log. Even if you solve the destructor problem above the
destructor will never be invoked (until global destruction) because of the (circular) reference
in the log.
Attached find mock_object_leak.pl, which reproduces the problem in Test::MockObject 1.02.
Expected behavior is that the weak references are cleared when we clear the normal
references. Actual behavior is that they persist until the "clear()" method is called, cleaning
the log.
Also attached is 'test-mockobject_leak_fix.diff', which is a patch against the T::MO 1.02
distribution. It includes a fix to the module and added tests in 'bugs.t' to verify the fix.
I have tested this on MacOS X and Linux.
| Subject: | test-mockobject_leak_fix.diff |
diff -uNr Test-MockObject-1.02.old/lib/Test/MockObject.pm Test-MockObject-1.02/lib/Test/MockObject.pm
--- Test-MockObject-1.02.old/lib/Test/MockObject.pm 2005-12-24 01:25:27.000000000 -0800
+++ Test-MockObject-1.02/lib/Test/MockObject.pm 2006-03-02 09:34:09.000000000 -0800
@@ -6,7 +6,7 @@
use vars qw( $VERSION $AUTOLOAD );
$VERSION = '1.02';
-use Scalar::Util qw( blessed refaddr reftype );
+use Scalar::Util qw( blessed refaddr reftype weaken );
use UNIVERSAL::isa;
use UNIVERSAL::can;
@@ -225,9 +225,15 @@
sub log_call
{
my ($self, $sub) = splice( @_, 0, 2 );
-
return unless _logs( $self, $sub );
- push @{ _calls( $self ) }, [ $sub, [ @_ ] ];
+ my $call_args = [ @_ ];
+ # prevent circular references with weaken
+ foreach my $pos ( 0..$#{ $call_args } ) {
+ weaken $call_args->[$pos] if ( ref($call_args->[$pos]) and (refaddr $call_args->[$pos] eq refaddr $self) );
+# # or consider this bold strategy, if you dare:
+# weaken $call_args->[$pos] if ( blessed($call_args->[$pos]) and $call_args->[$pos]->isa(ref $self) );
+ }
+ push @{ _calls( $self ) }, [ $sub, $call_args ];
}
sub called_ok
@@ -293,6 +299,15 @@
$self->fake_module( $class, new => sub { $self } );
}
+sub DESTROY
+{
+ my $self = shift;
+ $self->_clear_calls();
+ $self->_clear_subs();
+ $self->_clear_logs();
+ $self->_clear_isas();
+}
+
sub _get_key
{
my $invocant = shift;
@@ -306,6 +321,11 @@
{
$calls{ _get_key( shift ) } ||= [];
}
+
+ sub _clear_calls
+ {
+ delete $calls{ _get_key( shift ) };
+ }
}
{
@@ -315,6 +335,11 @@
{
$subs{ _get_key( shift ) } ||= {};
}
+
+ sub _clear_subs
+ {
+ delete $subs{ _get_key( shift ) };
+ }
}
{
@@ -343,6 +368,11 @@
my ($name) = @_;
return exists $logs{$key}{$name};
}
+
+ sub _clear_logs
+ {
+ delete $logs{ _get_key( shift ) };
+ }
}
{
@@ -352,6 +382,11 @@
{
$isas{ _get_key( shift ) } ||= {};
}
+
+ sub _clear_isas
+ {
+ delete $isas{ _get_key( shift ) };
+ }
}
1;
diff -uNr Test-MockObject-1.02.old/t/bugs.t Test-MockObject-1.02/t/bugs.t
--- Test-MockObject-1.02.old/t/bugs.t 2005-12-24 01:25:27.000000000 -0800
+++ Test-MockObject-1.02/t/bugs.t 2006-03-02 09:32:44.000000000 -0800
@@ -2,8 +2,9 @@
use strict;
use warnings;
+use Scalar::Util qw(weaken);
-use Test::More tests => 14;
+use Test::More tests => 17;
use Test::MockObject;
my $mock = Test::MockObject->new();
@@ -114,3 +115,24 @@
$id = 'my id';
is( "$o", 'my id', '... and not be static' );
is( $o->foo(), 'foo', '... but should not interfere with method finding' );
+
+# no overload '""';
+
+# David Pisoni found memory leak condition
+{
+ # Setup MOs with 2 references
+ my($obj1, $obj2, $obj1prime, $obj2prime);
+ $obj1 = $obj1prime = Test::MockObject->new();
+ $obj2 = $obj2prime = Test::MockObject->new();
+ # Weaken one of the references each
+ weaken $obj1prime;
+ weaken $obj2prime;
+ # test for memory leak condition
+ $obj1->set_true('this');
+ $obj1->this($obj2);
+ undef $obj2;
+ is(ref($obj2prime), 'Test::MockObject', 'MO cached by another MO log should not be garbage collected');
+ undef $obj1;
+ ok( !ref($obj2prime), '... but should go away when caching MO is destructed' );
+ ok( !ref($obj1prime), '... and the caching MO better be gone too or it will just leak everywhere!' );
+}
| Subject: | mock_object_leak.pl |
#!/usr/bin/perl
use strict;
use Test::MockObject;
use Scalar::Util qw(weaken);
use Data::Dumper;
# setup and report
my($obj1, $obj2, %container);
$obj1 = $container{obj1} = Test::MockObject->new();
$obj2 = $container{obj2} = Test::MockObject->new();
weaken $container{obj1};
weaken $container{obj2};
print "Beginning state: " . Dumper(\%container);
# reproduce memory leak and report
$obj1->set_true('this');
$obj1->this($obj2);
undef $obj2;
undef $obj1;
print "After strong refs removed: " . Dumper(\%container);
# clear fixes this
$container{obj1}->clear();
print "After clear() method called: " . Dumper(\%container);