summaryrefslogtreecommitdiff
path: root/Data-MultiValued/t
diff options
context:
space:
mode:
Diffstat (limited to 'Data-MultiValued/t')
-rw-r--r--Data-MultiValued/t/more-overlapping-ranges.t63
-rw-r--r--Data-MultiValued/t/overlapping-ranges.t48
-rw-r--r--Data-MultiValued/t/ranges-setting.t60
-rw-r--r--Data-MultiValued/t/simple-setting.t22
-rw-r--r--Data-MultiValued/t/tags-ranges-setting.t68
-rw-r--r--Data-MultiValued/t/tags-setting.t42
6 files changed, 303 insertions, 0 deletions
diff --git a/Data-MultiValued/t/more-overlapping-ranges.t b/Data-MultiValued/t/more-overlapping-ranges.t
new file mode 100644
index 0000000..9ff1dc2
--- /dev/null
+++ b/Data-MultiValued/t/more-overlapping-ranges.t
@@ -0,0 +1,63 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->new();
+ok($obj,'constructor works');
+
+$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");
+}
+
+done_testing();
diff --git a/Data-MultiValued/t/overlapping-ranges.t b/Data-MultiValued/t/overlapping-ranges.t
new file mode 100644
index 0000000..e359894
--- /dev/null
+++ b/Data-MultiValued/t/overlapping-ranges.t
@@ -0,0 +1,48 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->new();
+ok($obj,'constructor works');
+
+$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';
+
+done_testing();
diff --git a/Data-MultiValued/t/ranges-setting.t b/Data-MultiValued/t/ranges-setting.t
new file mode 100644
index 0000000..148a4c6
--- /dev/null
+++ b/Data-MultiValued/t/ranges-setting.t
@@ -0,0 +1,60 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->new();
+ok($obj,'constructor works');
+
+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';
+
+done_testing();
diff --git a/Data-MultiValued/t/simple-setting.t b/Data-MultiValued/t/simple-setting.t
new file mode 100644
index 0000000..b478e7a
--- /dev/null
+++ b/Data-MultiValued/t/simple-setting.t
@@ -0,0 +1,22 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->new();
+ok($obj,'constructor works');
+
+lives_ok {
+ $obj->set({
+ value => 1234,
+ });
+} 'setting';
+
+cmp_ok($obj->get({}),'==',1234,
+ 'getting');
+
+lives_ok { $obj->clear } 'clearing the object';
+
+done_testing();
diff --git a/Data-MultiValued/t/tags-ranges-setting.t b/Data-MultiValued/t/tags-ranges-setting.t
new file mode 100644
index 0000000..7214ebe
--- /dev/null
+++ b/Data-MultiValued/t/tags-ranges-setting.t
@@ -0,0 +1,68 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->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)";
+ }
+}
+
+done_testing();
diff --git a/Data-MultiValued/t/tags-setting.t b/Data-MultiValued/t/tags-setting.t
new file mode 100644
index 0000000..d9f6fd8
--- /dev/null
+++ b/Data-MultiValued/t/tags-setting.t
@@ -0,0 +1,42 @@
+#!perl
+use strict;
+use warnings;
+use Test::Most 'die';
+use Data::Printer;
+use Data::MultiValued;
+
+my $obj = Data::MultiValued->new();
+ok($obj,'constructor works');
+
+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';
+
+done_testing();
generated by cgit v1.2.3 (git 2.46.0) at 2025-05-01 14:46:16 +0000