<html><head><meta name="color-scheme" content="light dark"></head><body><pre style="word-wrap: break-word; white-space: pre-wrap;">package Test2::Compare::Bag;
use strict;
use warnings;

use base 'Test2::Compare::Base';

our $VERSION = '0.000162';

use Test2::Util::HashBase qw/ending meta items for_each/;

use Carp qw/croak confess/;
use Scalar::Util qw/reftype looks_like_number/;

sub init {
    my $self = shift;

    $self-&gt;{+ITEMS}    ||= [];
    $self-&gt;{+FOR_EACH} ||= [];

    $self-&gt;SUPER::init();
}

sub name { '&lt;BAG&gt;' }

sub meta_class  { 'Test2::Compare::Meta' }

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_prop {
    my $self = shift;
    $self-&gt;{+META} = $self-&gt;meta_class-&gt;new unless defined $self-&gt;{+META};
    $self-&gt;{+META}-&gt;add_prop(@_);
}

sub add_item {
    my $self = shift;
    my $check = pop;
    my ($idx) = @_;

    push @{$self-&gt;{+ITEMS}}, $check;
}

sub add_for_each {
    my $self = shift;
    push @{$self-&gt;{+FOR_EACH}} =&gt; @_;
}

sub deltas {
    my $self = shift;
    my %params = @_;
    my ($got, $convert, $seen) = @params{qw/got convert seen/};

    my @deltas;
    my $state = 0;
    my @items = @{$self-&gt;{+ITEMS}};
    my @for_each = @{$self-&gt;{+FOR_EACH}};

    # Make a copy that we can munge as needed.
    my @list = @$got;
    my %unmatched = map { $_ =&gt; $list[$_] } 0..$#list;

    my $meta     = $self-&gt;{+META};
    push @deltas =&gt; $meta-&gt;deltas(%params) if defined $meta;

    while (@items) {
        my $item = shift @items;

        my $check = $convert-&gt;($item);

        my $match = 0;
        for my $idx (0..$#list) {
            next unless exists $unmatched{$idx};
            my $val = $list[$idx];
            my $deltas = $check-&gt;run(
                id      =&gt; [ARRAY =&gt; $idx],
                convert =&gt; $convert,
                seen    =&gt; $seen,
                exists  =&gt; 1,
                got     =&gt; $val,
            );

            unless ($deltas) {
                $match++;
                delete $unmatched{$idx};
                last;
            }
        }
        unless ($match) {
            push @deltas =&gt; $self-&gt;delta_class-&gt;new(
                dne      =&gt; 'got',
                verified =&gt; undef,
                id       =&gt; [ARRAY =&gt; '*'],
                got      =&gt; undef,
                check    =&gt; $check,
            );
        }
    }

    if (@for_each) {
        my @checks = map { $convert-&gt;($_) } @for_each;

        for my $idx (0..$#list) {
            # All items are matched if we have conditions for all items
            delete $unmatched{$idx};

            my $val = $list[$idx];

            for my $check (@checks) {
                push @deltas =&gt; $check-&gt;run(
                    id      =&gt; [ARRAY =&gt; $idx],
                    convert =&gt; $convert,
                    seen    =&gt; $seen,
                    exists  =&gt; 1,
                    got     =&gt; $val,
                );
            }
        }
    }

    # if elements are left over, and ending is true, we have a problem!
    if($self-&gt;{+ENDING} &amp;&amp; keys %unmatched) {
        for my $idx (sort keys %unmatched) {
            my $elem = $list[$idx];
            push @deltas =&gt; $self-&gt;delta_class-&gt;new(
                dne      =&gt; 'check',
                verified =&gt; undef,
                id       =&gt; [ARRAY =&gt; $idx],
                got      =&gt; $elem,
                check    =&gt; undef,

                $self-&gt;{+ENDING} eq 'implicit' ? (note =&gt; 'implicit end') : (),
            );
        }
    }

    return @deltas;
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

Test2::Compare::Bag - Internal representation of a bag comparison.

=head1 DESCRIPTION

This module is an internal representation of a bag for comparison purposes.

=head1 METHODS

=over 4

=item $bool = $arr-&gt;ending

=item $arr-&gt;set_ending($bool)

Set this to true if you would like to fail when the array being validated has
more items than the check. That is, if you check for 4 items but the array has
5 values, it will fail and list that unmatched item in the array as
unexpected. If set to false then it is assumed you do not care about extra
items.

=item $arrayref = $arr-&gt;items()

Returns the arrayref of values to be checked in the array.

=item $arr-&gt;set_items($arrayref)

Accepts an arrayref.

B&lt;Note:&gt; that there is no validation when using C&lt;set_items&gt;, it is better to
use the C&lt;add_item&gt; interface.

=item $name = $arr-&gt;name()

Always returns the string C&lt;&lt; "&lt;BAG&gt;" &gt;&gt;.

=item $bool = $arr-&gt;verify(got =&gt; $got, exists =&gt; $bool)

Check if C&lt;$got&gt; is an array reference or not.

=item $arr-&gt;add_item($item)

Push an item onto the list of values to be checked.

=item @deltas = $arr-&gt;deltas(got =&gt; $got, convert =&gt; \&amp;convert, seen =&gt; \%seen)

Find the differences between the expected bag values and those in the C&lt;$got&gt;
arrayref.

=back

=head1 SOURCE

The source code repository for Test2-Suite can be found at
F&lt;https://github.com/Test-More/Test2-Suite/&gt;.

=head1 MAINTAINERS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=item Gianni Ceccarelli E&lt;lt&gt;dakkar@thenautilus.netE&lt;gt&gt;

=back

=head1 AUTHORS

=over 4

=item Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;

=item Gianni Ceccarelli E&lt;lt&gt;dakkar@thenautilus.netE&lt;gt&gt;

=back

=head1 COPYRIGHT

Copyright 2018 Chad Granum E&lt;lt&gt;exodist@cpan.orgE&lt;gt&gt;.

Copyright 2018 Gianni Ceccarelli E&lt;lt&gt;dakkar@thenautilus.netE&lt;gt&gt;

This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

See F&lt;http://dev.perl.org/licenses/&gt;

=cut
</pre></body></html>