summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--author_t/leaks.t75
-rw-r--r--lib/Data/MultiValued/AttributeTrait.pm5
-rw-r--r--lib/Data/MultiValued/Ranges.pm15
-rw-r--r--lib/Data/MultiValued/Tags.pm9
-rw-r--r--lib/Data/MultiValued/TagsAndRanges.pm19
5 files changed, 97 insertions, 26 deletions
diff --git a/author_t/leaks.t b/author_t/leaks.t
new file mode 100644
index 0000000..f3c811b
--- /dev/null
+++ b/author_t/leaks.t
@@ -0,0 +1,75 @@
+#!perl
+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 Dash::Leak;
+
+my $ropts={from=>10,to=>20};
+
+my $json = JSON::XS->new->utf8;
+my $obj = Foo->new(rr=>'foo');
+$obj->rr_multi($ropts,777);
+
+subtest 'serialisation memory leak' => sub {
+ $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';
+ 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';
+
+ ok(1,'done');
+};
+
+subtest 'inner memory leak' => sub {
+ 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';
+
+ ok(1,'done');
+};
+
+done_testing();
diff --git a/lib/Data/MultiValued/AttributeTrait.pm b/lib/Data/MultiValued/AttributeTrait.pm
index eb8cbd3..4ebf474 100644
--- a/lib/Data/MultiValued/AttributeTrait.pm
+++ b/lib/Data/MultiValued/AttributeTrait.pm
@@ -2,7 +2,6 @@ package Data::MultiValued::AttributeTrait;
use Moose::Role;
use namespace::autoclean;
use Data::MultiValued::AttributeAccessors;
-use MooseX::Types::Moose qw(Str);
use Try::Tiny;
use namespace::autoclean;
@@ -51,7 +50,7 @@ C<$name> is the attribute name.
has 'full_storage_slot' => (
is => 'ro',
- isa => Str,
+ isa => 'Str',
lazy_build => 1,
);
sub _build_full_storage_slot { shift->name . '__MULTIVALUED_STORAGE__' }
@@ -86,7 +85,7 @@ my @accs_to_multiply=qw(accessor reader writer predicate clearer);
for my $acc (@accs_to_multiply) {
has "multi_$acc" => (
is => 'ro',
- isa => Str,
+ isa => 'Str',
predicate => "has_multi_$acc",
);
}
diff --git a/lib/Data/MultiValued/Ranges.pm b/lib/Data/MultiValued/Ranges.pm
index 5f193ba..d03153d 100644
--- a/lib/Data/MultiValued/Ranges.pm
+++ b/lib/Data/MultiValued/Ranges.pm
@@ -1,9 +1,8 @@
package Data::MultiValued::Ranges;
use Moose;
use namespace::autoclean;
-use MooseX::Params::Validate;
use Moose::Util::TypeConstraints;
-use MooseX::Types::Moose qw(Num Str Undef Any);
+use MooseX::Params::Validate;
use Data::MultiValued::Exceptions;
use Data::MultiValued::RangeContainer;
@@ -73,9 +72,9 @@ just stored.
sub set {
my ($self,%args) = validated_hash(
\@_,
- from => { isa => Num|Undef, optional => 1, },
- to => { isa => Num|Undef, optional => 1, },
- value => { isa => Any, },
+ from => { isa => 'Num|Undef', optional => 1, },
+ to => { isa => 'Num|Undef', optional => 1, },
+ value => { isa => 'Any', },
);
$self->_storage->get_or_create(\%args)
@@ -102,7 +101,7 @@ untouched.
sub get {
my ($self,%args) = validated_hash(
\@_,
- at => { isa => Num|Undef, optional => 1, },
+ at => { isa => 'Num|Undef', optional => 1, },
);
$self->_storage->get(\%args)
@@ -141,8 +140,8 @@ other words:
sub clear {
my ($self,%args) = validated_hash(
\@_,
- from => { isa => Num|Undef, optional => 1, },
- to => { isa => Num|Undef, optional => 1, },
+ from => { isa => 'Num|Undef', optional => 1, },
+ to => { isa => 'Num|Undef', optional => 1, },
);
$self->_storage->clear(\%args);
diff --git a/lib/Data/MultiValued/Tags.pm b/lib/Data/MultiValued/Tags.pm
index 8ba06f3..063a778 100644
--- a/lib/Data/MultiValued/Tags.pm
+++ b/lib/Data/MultiValued/Tags.pm
@@ -3,7 +3,6 @@ use Moose;
use namespace::autoclean;
use MooseX::Params::Validate;
use Moose::Util::TypeConstraints;
-use MooseX::Types::Moose qw(Num Str Undef Any);
use Data::MultiValued::Exceptions;
use Data::MultiValued::TagContainer;
@@ -52,8 +51,8 @@ just stored.
sub set {
my ($self,%args) = validated_hash(
\@_,
- tag => { isa => Str, optional => 1, },
- value => { isa => Any, },
+ tag => { isa => 'Str', optional => 1, },
+ value => { isa => 'Any', },
);
$self->_storage->get_or_create(\%args)
@@ -79,7 +78,7 @@ untouched.
sub get {
my ($self,%args) = validated_hash(
\@_,
- tag => { isa => Str, optional => 1, },
+ tag => { isa => 'Str', optional => 1, },
);
$self->_storage->get(\%args)
@@ -101,7 +100,7 @@ is no way to just clear the value for the C<undef> tag.
sub clear {
my ($self,%args) = validated_hash(
\@_,
- tag => { isa => Str, optional => 1, },
+ tag => { isa => 'Str', optional => 1, },
);
$self->_storage->clear(\%args);
diff --git a/lib/Data/MultiValued/TagsAndRanges.pm b/lib/Data/MultiValued/TagsAndRanges.pm
index 2f06452..43bff6b 100644
--- a/lib/Data/MultiValued/TagsAndRanges.pm
+++ b/lib/Data/MultiValued/TagsAndRanges.pm
@@ -3,7 +3,6 @@ use Moose;
use namespace::autoclean;
use MooseX::Params::Validate;
use Moose::Util::TypeConstraints;
-use MooseX::Types::Moose qw(Num Str Undef Any);
use Data::MultiValued::Exceptions;
use Data::MultiValued::TagContainerForRanges;
@@ -52,10 +51,10 @@ L<Data::MultiValued::Ranges/set> for more details.
sub set {
my ($self,%args) = validated_hash(
\@_,
- from => { isa => Num|Undef, optional => 1, },
- to => { isa => Num|Undef, optional => 1, },
- tag => { isa => Str, optional => 1, },
- value => { isa => Any, },
+ from => { isa => 'Num|Undef', optional => 1, },
+ to => { isa => 'Num|Undef', optional => 1, },
+ tag => { isa => 'Str', optional => 1, },
+ value => { isa => 'Any', },
);
$self->_storage->get_or_create(\%args)
@@ -82,8 +81,8 @@ L<Data::MultiValued::Ranges/get> for more details.
sub get {
my ($self,%args) = validated_hash(
\@_,
- at => { isa => Num|Undef, optional => 1, },
- tag => { isa => Str, optional => 1, },
+ at => { isa => 'Num|Undef', optional => 1, },
+ tag => { isa => 'Str', optional => 1, },
);
$self->_storage->get(\%args)
@@ -108,9 +107,9 @@ L<Data::MultiValued::Ranges/clear> for more details.
sub clear {
my ($self,%args) = validated_hash(
\@_,
- from => { isa => Num|Undef, optional => 1, },
- to => { isa => Num|Undef, optional => 1, },
- tag => { isa => Str, optional => 1, },
+ from => { isa => 'Num|Undef', optional => 1, },
+ to => { isa => 'Num|Undef', optional => 1, },
+ tag => { isa => 'Str', optional => 1, },
);
if (exists $args{from} || exists $args{to}) {
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-10 19:44:54 +0000