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 { '' } 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;