summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>2012-01-09 14:09:58 +0000
committerGianni Ceccarelli <gianni.ceccarelli@net-a-porter.com>2012-01-09 14:09:58 +0000
commit07ef384ae88febde8aaccc3bfa44c2dff98c4cdd (patch)
treeeb1a3379c3660cdd00dd1490edc1ba1b3b0efe99
parentremove MooseX::Types as far as sensible (diff)
downloaddata-multivalued-07ef384ae88febde8aaccc3bfa44c2dff98c4cdd.tar.gz
data-multivalued-07ef384ae88febde8aaccc3bfa44c2dff98c4cdd.tar.bz2
data-multivalued-07ef384ae88febde8aaccc3bfa44c2dff98c4cdd.zip
better leak tracing
-rw-r--r--author_t/leaks.t72
1 files changed, 42 insertions, 30 deletions
diff --git a/author_t/leaks.t b/author_t/leaks.t
index f3c811b..629f141 100644
--- a/author_t/leaks.t
+++ b/author_t/leaks.t
@@ -21,53 +21,65 @@ use Test::Most 'die';
use Data::Printer;
use JSON::XS;
BEGIN { $ENV{DEBUG_MEM}=1 };
-use Dash::Leak;
+use Test::LeakTrace;
my $ropts={from=>10,to=>20};
+sub new_obj {
+ my $obj = Foo->new(rr=>'foo');
+ $obj->rr_multi($ropts,777);
+ return $obj;
+}
+
+my $LOOP=1;
+
my $json = JSON::XS->new->utf8;
-my $obj = Foo->new(rr=>'foo');
-$obj->rr_multi($ropts,777);
subtest 'serialisation memory leak' => sub {
+ my $obj = new_obj;
$obj=Foo->new_in_place($json->decode($json->encode($obj->as_hash)));
- leaksz 'start memory leak';
- for my $iter (0..2000) {
- $obj=Foo->new_in_place($json->decode($json->encode($obj->as_hash)));
- }
- leaksz 'stop memory leak';
+ leaktrace {
+ for my $iter (1..$LOOP) {
+ $obj=Foo->new_in_place($json->decode($json->encode($obj->as_hash)));
+ }
+ $obj=undef;
+ } -verbose;
ok(1,'done');
};
subtest 'accessor memory leak' => sub {
- leaksz 'start memory leak';
- for my $iter (0..1000) {
- $obj->rr_multi({at=>35});
- }
- leaksz 'stop memory leak non-exist';
- leaksz '...';
- for my $iter (0..1000) {
- $obj->rr_multi({at=>15});
- }
- leaksz 'stop memory leak exist';
+ my $obj = new_obj;
+ leaktrace {
+ for my $iter (1..$LOOP) {
+ $obj->rr_multi({at=>35});
+ }
+ $obj=undef;
+ } -verbose;
+ $obj = new_obj;
+ leaktrace {
+ for my $iter (1..$LOOP) {
+ $obj->rr_multi({at=>15});
+ }
+ $obj=undef;
+ } -verbose;
ok(1,'done');
};
subtest 'inner memory leak' => sub {
- my $cont = $obj->{rr__MULTIVALUED_STORAGE__}
- {_storage};
+ my $obj = new_obj;
+ my $cont = $obj->{rr__MULTIVALUED_STORAGE__}{_storage};
- leaksz 'start memory leak';
- for my $iter (0..1000) {
- eval { $cont->get({at=>35}) }
- }
- leaksz 'stop memory leak non-exist';
- leaksz '...';
- for my $iter (0..1000) {
- $cont->get({at=>15});
- }
- leaksz 'stop memory leak exist';
+ leaktrace {
+ for my $iter (1..$LOOP) {
+ eval { $cont->get({at=>35}) }
+ }
+ } -verbose;
+ leaktrace {
+ for my $iter (1..$LOOP) {
+ $cont->get({at=>15});
+ }
+ } -verbose;
ok(1,'done');
};