move up a level

9 files changed, 642 insertions, 0 deletions

diff --git a/t/json.t b/t/json.t
new file mode 100644
index 0000000..5e00080
--- /dev/null
+++ b/t/json.t
@@ -0,0 +1,65 @@
+#!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 $json = JSON::XS->new->utf8;
+my $obj = Foo->new(rr=>'foo');
+$obj->tt_multi($opts,1234);
+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->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..6e1ac7a
--- /dev/null
+++ b/t/moose-tagged.t
@@ -0,0 +1,67 @@
+#!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',
+);
+
+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_multi($opts),'not has stuff tagged');
+    ok(!$obj->has_other,'not has other');
+    ok(!$obj->has_other_multi($opts),'not has other tagged');
+
+    $obj->stuff_multi($opts,7);
+    $obj->other_multi($opts,'foo');
+
+    is($obj->stuff,3,'default');
+    is($obj->stuff_multi($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..b8d2a57
--- /dev/null
+++ b/t/ranges-setting.t
@@ -0,0 +1,93 @@
+#!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';
+
+    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';
+
+    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();