more tests!

also, some test library

1 files changed, 109 insertions, 0 deletions

diff --git a/t/lib/Test2/Compare/Bag.pm b/t/lib/Test2/Compare/Bag.pm
new file mode 100644
index 0000000..e4dc224
--- /dev/null
+++ b/t/lib/Test2/Compare/Bag.pm
@@ -0,0 +1,109 @@
+package Test2::Compare::Bag;
+use strict;
+use warnings;
+
+use base 'Test2::Compare::Base';
+
+our $VERSION = '0.000030';
+
+use Test2::Util::HashBase qw/ending items/;
+
+use Carp qw/croak confess/;
+use Scalar::Util qw/reftype looks_like_number/;
+
+sub init {
+    my $self = shift;
+
+    $self->{+ITEMS} ||= [];
+
+    $self->SUPER::init();
+}
+
+sub name { '<BAG>' }
+
+sub verify {
+    my $self = shift;
+    my %params = @_;
+
+    return 0 unless $params{exists};
+    my $got = $params{got} || return 0;
+    return 0 unless ref($got);
+    return 0 unless reftype($got) eq 'ARRAY';
+    return 1;
+}
+
+sub add_item {
+    my $self = shift;
+    my $check = pop;
+    my ($idx) = @_;
+
+    push @{$self->{+ITEMS}}, $check;
+}
+
+sub deltas {
+    my $self = shift;
+    my %params = @_;
+    my ($got, $convert, $seen) = @params{qw/got convert seen/};
+
+    my @deltas;
+    my $state = 0;
+    my @items = @{$self->{+ITEMS}};
+
+    # Make a copy that we can munge as needed.
+    my @list = @$got;
+    my %unmatched = map { $_ => $list[$_] } 0..$#list;
+
+    while (@items) {
+        my $item = shift @items;
+
+        my $check = $convert->($item);
+
+        my @item_deltas;
+        for my $idx (0..$#list) {
+            my $val = $list[$idx];
+            my @this_deltas = $check->run(
+                id      => [ARRAY => $idx],
+                convert => $convert,
+                seen    => $seen,
+                exists  => 1,
+                got     => $val,
+            );
+            if (@this_deltas) {
+                push @item_deltas,@this_deltas;
+            }
+            else {
+                @item_deltas = ();
+                delete $unmatched{$idx};
+                last;
+            }
+        }
+        if (@item_deltas) {
+            push @deltas, $self->delta_class->new(
+                dne      => 'got',
+                verified => 1,
+                id       => [ARRAY => '*'],
+                got      => undef,
+                check    => $check,
+                children => \@item_deltas,
+            );
+        }
+    }
+
+    # if elements are left over, and ending is true, we have a problem!
+    if($self->{+ENDING} && keys %unmatched) {
+        for my $idx (sort keys %unmatched) {
+            my $elem = $list[$idx];
+            push @deltas => $self->delta_class->new(
+                dne      => 'check',
+                verified => undef,
+                id       => [ARRAY => $idx],
+                got      => $elem,
+                check    => undef,
+            );
+        }
+    }
+
+    return @deltas;
+}
+
+1;