Memory leak in Set::Object

parmus has asked for the wisdom of the Perl Monks concerning the following question:

This is a continuation of Weird memory leak in Catalyst application using Catalyst::Model::KiokuDB, but I've split it into it's own node for clarification and to make it easier for other users to find.

I've found a memory leak in Set::Object-1.28, and using a combination of Test::LeakTrace and Test::Valgrind (thanks, zwon!) I tracked it down to Object.xs. The three test scripts I used to demonstrate and track down the bug is listed in the bottom.

I've made the following patch and submitted it in a bug report at CPAN:

--- Set-Object-1.28/Object.xs    2010-07-14 06:42:11.000000000 +0200
+++ /home/parmus/Projects/Set-Object-1.28/Object.xs    2011-08-04 02:0
+1:56.357000046 +0200
@@ -358,23 +358,8 @@
      i--;
        }
        if (!c) {
-     /* we should clear the magic, really. */
-     MAGIC* last = 0;
-     for (mg = SvMAGIC(sv); mg; mg = mg->mg_moremagic) {
-       if (mg->mg_type == SET_OBJECT_MAGIC_backref) {
-         if (last) {
-           last->mg_moremagic = mg->mg_moremagic;
-           Safefree(mg);
-           break;
-         } else if (mg->mg_moremagic) {
-           SvMAGIC(sv) = mg->mg_moremagic;
-         } else {
-           SvMAGIC(sv) = 0;
-           SvAMAGIC_off(sv);
-         }
-       }
-       last=mg;
-     }
+     sv_unmagic(sv, SET_OBJECT_MAGIC_backref);
+     SvREFCNT_dec(wand);
        }
     }
 }
[download]

So now I have two questions for the collective wisdom of the Perl community:

This is my first time with XS and Perl internals. Can anyone here verify the soundness of my patch? Especially, is the any obvious XS or Perl idioms I'm missing?
Apart from finding the bug, making the patch, submitting the bug report and asking the community to validate my findings and my patch (this node), is there any other "How to by a nice Perl hacker"-steps, that I'm missing?

Test scripts used to demonstrate and debug this leak

memory_usage.pl:

#!/usr/bin/perl -w
use strict;
use warnings;
use Set::Object;
use Memory::Usage;

{
    package Foo;
    use Moose;
    __PACKAGE__->meta->make_immutable;
    1;
}

my $mu = Memory::Usage->new;

$mu->record('Start');

{
    my $set = Set::Object::Weak->new;
    $mu->record('After creating the set');
    for my $outer (1..5){
        for my $inner (1..10000){
            my $obj = Foo->new;
            $set->insert($obj);
            $set->remove($obj);
        }
        $mu->record(join ' ', 'After doing', 10000*$outer, 'inserts an
+d removes');
    }
}
$mu->record('After destroying the set');
print $mu->report;
[download]

valgrind_weak.pl:

#!/usr/bin/perl -w
use strict;
use warnings;
use Test::More;
use Set::Object;
use Scalar::Util qw(refaddr);

{
    package Foo;
    use Moose;
    __PACKAGE__->meta->make_immutable;
    1;
}

eval 'use Test::Valgrind';
plan skip_all => 'Test::Valgrind is required to test your distribution
+ with valgrind' if $@;

{
    my $set = Set::Object::Weak->new;
    {
        my $obj = Foo->new;
        $set->insert($obj);
        $set->remove($obj);
    }
}
[download]

internal_leaks.pl:

#!/usr/bin/perl -w
use strict;
use warnings;
use Config;
use Test::More;
use Test::LeakTrace;
use Set::Object;

{
    package Foo;
    use Moose;
    __PACKAGE__->meta->make_immutable;
    1;
}

{
    no strict;
    note join ' ', map {$Config{$_}} qw(osname archname);
    note 'perl version ', $];
    note $_,'-',${"${_}::VERSION"} for qw{Moose Set::Object Test::Leak
+Trace};
}

my $set;
{
    $set = Set::Object->new;
    no_leaks_ok {
        {
            my $obj = Foo->new;
            $set->insert($obj);
            $set->remove($obj);
        }
    } 'Testing Set::Object for leaking';
}

{
    $set = Set::Object::Weak->new;
    no_leaks_ok {
        {
            my $obj = Foo->new;
            $set->insert($obj);
            $set->remove($obj);
        }
    } 'Testing Set::Object::Weak for leaking';
}

done_testing;
[download]

Comment on Memory leak in Set::Object Select or Download Code

Replies are listed 'Best First'.
Re: Memory leak in Set::Object by DrHyde (Prior) on Aug 04, 2011 at 10:41 UTC
I can't verify the XS, but you've done everything right and I'd be happy to receive a bug report like this for one of my modules. The only thing that would make it even better would be if you were to also include a test that fails with the old leaky code and passes when your patch is applied.	[reply]
Re^2: Memory leak in Set::Object by parmus (Novice) on Aug 04, 2011 at 10:51 UTC
I did (^_^) That's what `internal_leaks.pl` is for. I've renamed it to `internal_leaks.t` and submitted all three scripts to the bug report. Thanks for the reply.	[reply]