diff options
| -rw-r--r-- | author_t/leaks.t | 72 |
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'); }; |