use strict;
use warnings;
package Foo;{
use Moose;
use Data::MultiValued::AttributeTrait::Ranges;
with 'Data::MultiValued::UglySerializationHelperRole';
has rr => (
is => 'rw',
isa => 'Str',
traits => ['MultiValued::Ranges'],
predicate => 'has_rr',
clearer => 'clear_rr',
);
}
package main;
use Test::Most 'die';
use Data::Printer;
use JSON::XS;
BEGIN { $ENV{DEBUG_MEM}=1 };
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;
subtest 'serialisation memory leak' => sub {
my $obj = new_obj;
$obj=Foo->new_in_place($json->decode($json->encode($obj->as_hash)));
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 {
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 $obj = new_obj;
my $cont = $obj->{rr__MULTIVALUED_STORAGE__}{_storage};
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');
};
done_testing();