| Subject: | Memory leak / cycle |
Mail::Thread::Container leaks memory, as far as I can tell.
The attached patch fixes it, as far as I (and Devel::Cycle) can tell.
I also inlined the patch here to make it easier to read:
diff -ruwN Mail-Thread-2.55/Makefile.PL Mail-Thread-ask/Makefile.PL
--- Mail-Thread-2.55/Makefile.PL 2006-10-30 00:40:36.000000000 -0800
+++ Mail-Thread-ask/Makefile.PL 2006-11-05 02:52:40.000000000 -0800
@@ -5,6 +5,7 @@
'VERSION_FROM' => 'Thread.pm',
'PREREQ_PM' => {
'Test::More' => 0,
+ 'Scalar::Util' => 0,
'Email::Abstract' => 0 ,
},
ABSTRACT_FROM => 'Thread.pm',
diff -ruwN Mail-Thread-2.55/Thread.pm Mail-Thread-ask/Thread.pm
--- Mail-Thread-2.55/Thread.pm 2006-10-30 00:50:26.000000000 -0800
+++ Mail-Thread-ask/Thread.pm 2006-11-05 02:45:01.000000000 -0800
@@ -316,18 +316,18 @@
package Mail::Thread::Container;
use Carp qw(carp confess croak cluck);
+use Scalar::Util qw(weaken);
sub new { my $self = shift; bless { id => shift }, $self; }
sub message { $_[0]->{message} = $_[1] if @_ == 2; $_[0]->{message} }
+sub parent { @_ == 2 ? weaken($_[0]->{parent} = $_[1]) : $_[0]->{parent} }
sub child { $_[0]->{child} = $_[1] if @_ == 2; $_[0]->{child} }
-sub parent { $_[0]->{parent} = $_[1] if @_ == 2; $_[0]->{parent} }
sub next { $_[0]->{next} = $_[1] if @_ == 2; $_[0]->{next} }
sub messageid { $_[0]->{id} = $_[1] if @_ == 2; $_[0]->{id} }
sub subject { $_[0]->header("subject") }
sub header { $_[0]->message and eval { my $s = Email::Abstract->get_header($_[0]-
Show quoted text
>message, $_[1] ) || ''; chomp $s; $s; } }
-
sub topmost {
my $self = shift;
diff -ruwN Mail-Thread-2.55/t/1.t Mail-Thread-ask/t/1.t
--- Mail-Thread-2.55/t/1.t 2006-10-30 00:46:19.000000000 -0800
+++ Mail-Thread-ask/t/1.t 2006-11-05 02:49:23.000000000 -0800
@@ -1,7 +1,7 @@
#!perl -w
BEGIN { require 't/common.pl' }
-use Test::More tests => 3;
+use Test::More tests => 4;
use_ok("Mail::Thread");
my $threader = new Mail::Thread( slurp_messages('t/testbox') );
@@ -15,6 +15,12 @@
is($threader->rootset, 3, "We have three main threads");
+eval "use Test::Memory::Cycle";
+SKIP: {
+ skip "Test::Memory::Cycle not available", 1 if $@;
+ memory_cycle_ok($threader, 'threader not cycled');
+}
+
my @stuff;
dump_into($threader => \@stuff);
diff -ruwN Mail-Thread-2.55/t/6-cycle.t Mail-Thread-ask/t/6-cycle.t
--- Mail-Thread-2.55/t/6-cycle.t 1969-12-31 16:00:00.000000000 -0800
+++ Mail-Thread-ask/t/6-cycle.t 2006-11-05 02:50:40.000000000 -0800
@@ -0,0 +1,15 @@
+#!perl -w
+BEGIN { require 't/common.pl' }
+
+use Test::More;
+eval "use Test::Memory::Cycle";
+plan skip_all => "Test::Memory::Cycle required for this test" if $@;
+plan tests => 2;
+
+use_ok("Mail::Thread");
+
+my $threader = new Mail::Thread(slurp_messages('t/testbox-6'));
+$threader->thread;
+
+memory_cycle_ok($threader, 'threader not cycled');
+
| Subject: | memory-leak.patch |
diff -ruwN Mail-Thread-2.55/Makefile.PL Mail-Thread-ask/Makefile.PL
--- Mail-Thread-2.55/Makefile.PL 2006-10-30 00:40:36.000000000 -0800
+++ Mail-Thread-ask/Makefile.PL 2006-11-05 02:52:40.000000000 -0800
@@ -5,6 +5,7 @@
'VERSION_FROM' => 'Thread.pm',
'PREREQ_PM' => {
'Test::More' => 0,
+ 'Scalar::Util' => 0,
'Email::Abstract' => 0 ,
},
ABSTRACT_FROM => 'Thread.pm',
diff -ruwN Mail-Thread-2.55/Thread.pm Mail-Thread-ask/Thread.pm
--- Mail-Thread-2.55/Thread.pm 2006-10-30 00:50:26.000000000 -0800
+++ Mail-Thread-ask/Thread.pm 2006-11-05 02:45:01.000000000 -0800
@@ -316,18 +316,18 @@
package Mail::Thread::Container;
use Carp qw(carp confess croak cluck);
+use Scalar::Util qw(weaken);
sub new { my $self = shift; bless { id => shift }, $self; }
sub message { $_[0]->{message} = $_[1] if @_ == 2; $_[0]->{message} }
+sub parent { @_ == 2 ? weaken($_[0]->{parent} = $_[1]) : $_[0]->{parent} }
sub child { $_[0]->{child} = $_[1] if @_ == 2; $_[0]->{child} }
-sub parent { $_[0]->{parent} = $_[1] if @_ == 2; $_[0]->{parent} }
sub next { $_[0]->{next} = $_[1] if @_ == 2; $_[0]->{next} }
sub messageid { $_[0]->{id} = $_[1] if @_ == 2; $_[0]->{id} }
sub subject { $_[0]->header("subject") }
sub header { $_[0]->message and eval { my $s = Email::Abstract->get_header($_[0]->message, $_[1] ) || ''; chomp $s; $s; } }
-
sub topmost {
my $self = shift;
diff -ruwN Mail-Thread-2.55/t/1.t Mail-Thread-ask/t/1.t
--- Mail-Thread-2.55/t/1.t 2006-10-30 00:46:19.000000000 -0800
+++ Mail-Thread-ask/t/1.t 2006-11-05 02:49:23.000000000 -0800
@@ -1,7 +1,7 @@
#!perl -w
BEGIN { require 't/common.pl' }
-use Test::More tests => 3;
+use Test::More tests => 4;
use_ok("Mail::Thread");
my $threader = new Mail::Thread( slurp_messages('t/testbox') );
@@ -15,6 +15,12 @@
is($threader->rootset, 3, "We have three main threads");
+eval "use Test::Memory::Cycle";
+SKIP: {
+ skip "Test::Memory::Cycle not available", 1 if $@;
+ memory_cycle_ok($threader, 'threader not cycled');
+}
+
my @stuff;
dump_into($threader => \@stuff);
diff -ruwN Mail-Thread-2.55/t/6-cycle.t Mail-Thread-ask/t/6-cycle.t
--- Mail-Thread-2.55/t/6-cycle.t 1969-12-31 16:00:00.000000000 -0800
+++ Mail-Thread-ask/t/6-cycle.t 2006-11-05 02:50:40.000000000 -0800
@@ -0,0 +1,15 @@
+#!perl -w
+BEGIN { require 't/common.pl' }
+
+use Test::More;
+eval "use Test::Memory::Cycle";
+plan skip_all => "Test::Memory::Cycle required for this test" if $@;
+plan tests => 2;
+
+use_ok("Mail::Thread");
+
+my $threader = new Mail::Thread(slurp_messages('t/testbox-6'));
+$threader->thread;
+
+memory_cycle_ok($threader, 'threader not cycled');
+