diff options
Diffstat (limited to 't')
| -rw-r--r-- | t/json.t | 68 | ||||
| -rw-r--r-- | t/moose-ranges.t | 67 | ||||
| -rw-r--r-- | t/moose-tagged.t | 69 | ||||
| -rw-r--r-- | t/more-overlapping-ranges.t | 79 | ||||
| -rw-r--r-- | t/overlapping-ranges.t | 64 | ||||
| -rw-r--r-- | t/ranges-setting.t | 105 | ||||
| -rw-r--r-- | t/simple-setting.t | 46 | ||||
| -rw-r--r-- | t/tags-ranges-setting.t | 85 | ||||
| -rw-r--r-- | t/tags-setting.t | 76 |
9 files changed, 659 insertions, 0 deletions
diff --git a/t/json.t b/t/json.t new file mode 100644 index 0000000..d1162b3 --- /dev/null +++ b/t/json.t @@ -0,0 +1,68 @@ +#!perl +use strict; +use warnings; +package Foo;{ +use Moose; +use Data::MultiValued::AttributeTrait::Tags; +use Data::MultiValued::AttributeTrait::Ranges; +use Data::MultiValued::AttributeTrait::TagsAndRanges; + +with 'Data::MultiValued::UglySerializationHelperRole'; + +has tt => ( + is => 'rw', + isa => 'Int', + traits => ['MultiValued::Tags'], + default => 3, + predicate => 'has_tt', + clearer => 'clear_tt', +); + +has rr => ( + is => 'rw', + isa => 'Str', + traits => ['MultiValued::Ranges'], + predicate => 'has_rr', + clearer => 'clear_rr', +); + +has ttrr => ( + is => 'rw', + isa => 'Str', + default => 'default', + traits => ['MultiValued::TagsAndRanges'], + predicate => 'has_ttrr', + clearer => 'clear_ttrr', +); + + +} +package main; +use Test::Most 'die'; +use Data::Printer; +use JSON::XS; + +my $opts={tag=>'something'}; +my $ropts={tag=>'something',from=>10,to=>20}; + +my $json = JSON::XS->new->utf8; +my $obj = Foo->new(rr=>'foo'); +$obj->tt_multi($opts,1234); +$obj->ttrr_multi($ropts,777); +my $hash = $obj->as_hash; +note p $hash; +my $str = $json->encode($hash); +note p $str; + +note "rebuilding"; +my $obj2 = Foo->new_in_place($json->decode($str)); + +note p $obj; +note p $obj2; + +is($obj2->tt,$obj->tt,'tt'); +is($obj2->tt_multi($opts),$obj->tt_multi($opts),'tt tagged'); +is($obj2->ttrr_multi({at => 15}),$obj->ttrr_multi({at => 15}),'ttrr'); +is($obj2->rr,$obj->rr,'rr'); + +done_testing; diff --git a/t/moose-ranges.t b/t/moose-ranges.t new file mode 100644 index 0000000..404e649 --- /dev/null +++ b/t/moose-ranges.t @@ -0,0 +1,67 @@ +#!perl +use strict; +use warnings; + +package Foo;{ +use Moose; +use Data::MultiValued::AttributeTrait::Ranges; + +has stuff => ( + is => 'rw', + isa => 'Int', + traits => ['MultiValued::Ranges'], + default => 3, + predicate => 'has_stuff', + clearer => 'clear_stuff', +); + +has other => ( + is => 'rw', + isa => 'Str', + traits => ['MultiValued::Ranges'], + predicate => 'has_other', + clearer => 'clear_other', +); +} +package main; +use Test::Most 'die'; +use Data::Printer; + +subtest 'default' => sub { + my $obj = Foo->new(); + + ok(!$obj->has_other,'not has other'); + ok($obj->has_stuff,'has stuff'); + + is($obj->stuff,3,'default'); +}; + +subtest 'constructor param' => sub { + my $obj = Foo->new({stuff=>12,other=>'bar'}); + + ok($obj->has_other,'has other'); + ok($obj->has_stuff,'has stuff'); + + is($obj->stuff,12,'param'); + is($obj->other,'bar','param'); +}; + +subtest 'with ranges' => sub { + my $obj = Foo->new(); + + my $opts = {from=>10,to=>20,at=>15}; + + ok($obj->has_stuff,'has stuff'); + ok($obj->has_stuff_multi($opts),'has stuff ranged (forever)'); + ok(!$obj->has_other,'not has other'); + ok(!$obj->has_other_multi($opts),'not has other ranged'); + + $obj->stuff_multi($opts,7); + $obj->other_multi($opts,'foo'); + + is($obj->stuff,3,'default'); + is($obj->stuff_multi($opts),7,'stuff ranged'); + is($obj->other_multi($opts),'foo','other ranged'); +}; + +done_testing(); diff --git a/t/moose-tagged.t b/t/moose-tagged.t new file mode 100644 index 0000000..2493aff --- /dev/null +++ b/t/moose-tagged.t @@ -0,0 +1,69 @@ +#!perl +use strict; +use warnings; + +package Foo;{ +use Moose; +use Data::MultiValued::AttributeTrait::Tags; + +has stuff => ( + is => 'rw', + isa => 'Int', + traits => ['MultiValued::Tags'], + default => 3, + predicate => 'has_stuff', + clearer => 'clear_stuff', + multi_accessor => 'stuff_tagged', + multi_predicate => 'has_stuff_tagged', +); + +has other => ( + is => 'rw', + isa => 'Str', + traits => ['MultiValued::Tags'], + predicate => 'has_other', + clearer => 'clear_other', +); +} +package main; +use Test::Most 'die'; +use Data::Printer; + +subtest 'default' => sub { + my $obj = Foo->new(); + + ok(!$obj->has_other,'not has other'); + ok($obj->has_stuff,'has stuff'); + + is($obj->stuff,3,'default'); +}; + +subtest 'constructor param' => sub { + my $obj = Foo->new({stuff=>12,other=>'bar'}); + + ok($obj->has_other,'has other'); + ok($obj->has_stuff,'has stuff'); + + is($obj->stuff,12,'param'); + is($obj->other,'bar','param'); +}; + +subtest 'with tags' => sub { + my $obj = Foo->new(); + + my $opts = {tag=>'one'}; + + ok($obj->has_stuff,'has stuff'); + ok(!$obj->has_stuff_tagged($opts),'not has stuff tagged'); + ok(!$obj->has_other,'not has other'); + ok(!$obj->has_other_multi($opts),'not has other tagged'); + + $obj->stuff_tagged($opts,7); + $obj->other_multi($opts,'foo'); + + is($obj->stuff,3,'default'); + is($obj->stuff_tagged($opts),7,'stuff tagged'); + is($obj->other_multi($opts),'foo','other tagged'); +}; + +done_testing(); diff --git a/t/more-overlapping-ranges.t b/t/more-overlapping-ranges.t new file mode 100644 index 0000000..19e2fe5 --- /dev/null +++ b/t/more-overlapping-ranges.t @@ -0,0 +1,79 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + $obj->set({ + from=>10, + to=>20, + value=>1, + }); + $obj->set({ + from=>30, + to => 50, + value => 2, + }); + $obj->set({ + from=>15, + to => 35, + value => 3, + }); + $obj->set({ + from => undef, + to => 12, + value => 4, + }); + $obj->set({ + from => 40, + to => undef, + value => 5, + }); + + my %points = ( + 1,4, + 9,4, + 10,4, + 11,4, + 12,1, + 13,1, + 14,1, + 15,3, + 19,3, + 20,3, + 30,3, + 34,3, + 35,2, + 39,2, + 40,5, + 50,5, + 200,5, + ); + while (my ($at,$v) = each %points) { + cmp_ok($obj->get({at=>$at}), + '==', + $v, + "value at $at"); + } +} + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +done_testing(); diff --git a/t/overlapping-ranges.t b/t/overlapping-ranges.t new file mode 100644 index 0000000..01bb98d --- /dev/null +++ b/t/overlapping-ranges.t @@ -0,0 +1,64 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + $obj->set({ + from=>10, + to=>20, + value=>1, + }); + $obj->set({ + from=>15, + to => 30, + value => 2, + }); + + my %points = ( + 10,1, + 12,1, + 13,1, + 14,1, + 15,2, + 17,2, + 19,2, + 20,2, + 25,2, + 29,2, + ); + while (my ($at,$v) = each %points) { + cmp_ok($obj->get({at=>$at}), + '==', + $v, + "value at $at"); + } + + dies_ok { + $obj->get({at=>30}) + } 'far end'; + dies_ok { + $obj->get({at=>9}) + } 'far end'; +} + + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +done_testing(); diff --git a/t/ranges-setting.t b/t/ranges-setting.t new file mode 100644 index 0000000..e8f4c77 --- /dev/null +++ b/t/ranges-setting.t @@ -0,0 +1,105 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::Ranges; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + lives_ok { + $obj->set({ + from => 10, + to => 20, + value => [1,2,3], + }); + } 'setting 10-20'; + lives_ok { + $obj->set({ + from => 30, + to => 50, + value => [4,5,6], + }); + } 'setting 30-50'; + + lives_ok { + $obj->set({ + from => 25, + to => 27, + value => [7,8,9], + }); + } 'setting 30-50'; + + cmp_deeply($obj->get({at => 15}), + [1,2,3], + 'getting 15'); + cmp_deeply($obj->get({at => 10}), + [1,2,3], + 'getting 10'); + cmp_deeply($obj->get({at => 19.999}), + [1,2,3], + 'getting 19.999'); + dies_ok { + $obj->get({at => 20}) + } 'getting 20 dies'; + + cmp_deeply($obj->get({at => 40}), + [4,5,6], + 'getting 40'); + cmp_deeply($obj->get({at => 30}), + [4,5,6], + 'getting 30'); + cmp_deeply($obj->get({at => 49.999}), + [4,5,6], + 'getting 49.999'); + dies_ok { + $obj->get({at => 50}) + } 'getting 50 dies'; + + cmp_deeply($obj->get({at => 25}), + [7,8,9], + 'getting 25'); + + dies_ok { + $obj->get({at => 0}) + } 'getting 0 dies'; + + dies_ok { + $obj->get({}); + } 'default get dies'; + + $obj->clear({from=>10,to=>20}); + + dies_ok { + $obj->get({at => 15}) + } 'getting 15 after clearing dies'; + + cmp_deeply($obj->get({at => 30}), + [4,5,6], + 'getting 30 after clearing'); + + $obj->clear(); + + dies_ok { + $obj->get({at => 30}) + } 'getting 30 after clearing all dies'; + +} + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +done_testing(); diff --git a/t/simple-setting.t b/t/simple-setting.t new file mode 100644 index 0000000..9d9a9e2 --- /dev/null +++ b/t/simple-setting.t @@ -0,0 +1,46 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::Ranges; +use Data::MultiValued::Tags; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + lives_ok { + $obj->set({ + value => 1234, + }); + } 'setting'; + + cmp_ok($obj->get({}),'==',1234, + 'getting'); + + lives_ok { $obj->clear } 'clearing the object'; +} + +subtest 'ranges' => sub { + my $obj = Data::MultiValued::Ranges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags' => sub { + my $obj = Data::MultiValued::Tags->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +done_testing(); diff --git a/t/tags-ranges-setting.t b/t/tags-ranges-setting.t new file mode 100644 index 0000000..e25a9f1 --- /dev/null +++ b/t/tags-ranges-setting.t @@ -0,0 +1,85 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::TagsAndRanges; + +my $obj = Data::MultiValued::TagsAndRanges->new(); +ok($obj,'constructor works'); + +my @tags = (undef,'tag1','tag2'); +my @ranges = ([10,20,2],[30,50,2]); + +sub _t { $_[0] ? ( tag => $_[0] ) : () } + +for my $tag (@tags) { + for my $range (@ranges) { + $obj->set({ + _t($tag), + from => $range->[0], + to => $range->[1], + value => $range->[2], + }); + } +} + +for my $tag (@tags) { + for my $range (@ranges) { + cmp_ok( + $obj->get({ + _t($tag), + at => ($range->[0]+$range->[1])/2, + }), + '==', + $range->[2], + "tag @{[ $tag // 'default' ]}, range @$range[0,1]", + ); + } +} + +for my $range (@ranges) { + dies_ok { + $obj->get({ + tag => 'not there', + from => $range->[0], + to => $range->[1], + }) + } "no such tag, range @$range[0,1]"; +} + +for my $tag (@tags) { + for my $range (@ranges) { + dies_ok { + $obj->get({ + _t($tag), + at => $range->[0]-1, + }) + } "tag @{[ $tag // 'default' ]}, out-of-range (left)"; + dies_ok { + $obj->get({ + _t($tag), + at => $range->[1], + }) + } "tag @{[ $tag // 'default' ]}, out-of-range (right)"; + } +} + +$obj->clear({tag=>$tags[1],from=>$ranges[0]->[0],to=>$ranges[0]->[1]}); +dies_ok { + $obj->get({ + tag=>$tags[1], + at => $ranges[0]->[0]+1, + }) +} 'getting deleted range from inside tag dies'; + +cmp_ok( + $obj->get({ + tag => $tags[1], + at => $ranges[1]->[0]+1, + }), + '==', + $ranges[1]->[2], + 'other ranges in same tag are still there'); + +done_testing(); diff --git a/t/tags-setting.t b/t/tags-setting.t new file mode 100644 index 0000000..929ad3d --- /dev/null +++ b/t/tags-setting.t @@ -0,0 +1,76 @@ +#!perl +use strict; +use warnings; +use Test::Most 'die'; +use Data::Printer; +use Data::MultiValued::Tags; +use Data::MultiValued::TagsAndRanges; + +sub test_it { + my ($obj) = @_; + + lives_ok { + $obj->set({ + tag => 'tag1', + value => 'a string', + }); + } 'setting tag1'; + lives_ok { + $obj->set({ + tag => 'tag2', + value => 'another string', + }); + } 'setting tag2'; + + cmp_ok($obj->get({tag => 'tag1'}), + 'eq', + 'a string', + 'getting tag1'); + + cmp_ok($obj->get({tag => 'tag2'}), + 'eq', + 'another string', + 'getting tag2'); + + dies_ok { + $obj->get({tag=>'no such tag'}); + } 'getting non-existent tag'; + + dies_ok { + $obj->get({}); + } 'default get dies'; + + $obj->clear({tag=>'tag1'}); + + dies_ok { + $obj->get({tag=>'tag1'}); + } 'getting cleared tag'; + + cmp_ok($obj->get({tag => 'tag2'}), + 'eq', + 'another string', + 'getting tag2 after clearing'); + + $obj->clear(); + + dies_ok { + $obj->get({tag=>'tag2'}); + } 'getting tag2 after clearing all dies'; + +} + +subtest 'tags' => sub { + my $obj = Data::MultiValued::Tags->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +subtest 'tags and ranges' => sub { + my $obj = Data::MultiValued::TagsAndRanges->new(); + ok($obj,'constructor works'); + + test_it($obj); +}; + +done_testing(); |