summaryrefslogtreecommitdiff
path: root/author_t/leaks.t
diff options
context:
space:
mode:
Diffstat (limited to 'author_t/leaks.t')
-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');
};