File Coverage

blib/lib/Test2/Compare/Array.pm

Criterion	Covered	Total	%
statement	117	117	100.0
branch	45	48	93.7
condition	29	30	96.6
subroutine	16	16	100.0
pod	6	10	60.0
total	213	221	96.3

package Test2::Compare::Array;
use strict;
use warnings;

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

our $VERSION = '0.000153';

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

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

sub init {
    my $self = shift;

    if( defined( my $ref = $self->{+INREF}) ) {
        croak "Cannot specify both 'inref' and 'items'" if $self->{+ITEMS};
        croak "Cannot specify both 'inref' and 'order'" if $self->{+ORDER};
        croak "'inref' must be an array reference, got '$ref'" unless reftype($ref) eq 'ARRAY';
        my $order = $self->{+ORDER} = [];
        my $items = $self->{+ITEMS} = {};
        for (my $i = 0; $i < @$ref; $i++) {
            push @$order => $i;
            $items->{$i} = $ref->[$i];
        }
    }
    else {
        $self->{+ITEMS} ||= {};
        croak "All indexes listed in the 'items' hashref must be numeric"
            if grep { !looks_like_number($_) } keys %{$self->{+ITEMS}};

        $self->{+ORDER} ||= [sort { $a <=> $b } keys %{$self->{+ITEMS}}];
        croak "All indexes listed in the 'order' arrayref must be numeric"
            if grep { !(looks_like_number($_) || (ref($_) && reftype($_) eq 'CODE')) } @{$self->{+ORDER}};
    }

    $self->{+FOR_EACH} ||= [];

    $self->SUPER::init();
}

sub name { '' }

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

sub verify {
    my $self = shift;
    my %params = @_;

    return 0 unless $params{exists};
    my $got = $params{got};
    return 0 unless defined $got;
    return 0 unless ref($got);
    return 0 unless reftype($got) eq 'ARRAY';
    return 1;
}

sub add_prop {
    my $self = shift;
    $self->{+META} = $self->meta_class->new unless defined $self->{+META};
    $self->{+META}->add_prop(@_);
}

sub top_index {
    my $self = shift;
    my @order = @{$self->{+ORDER}};

    while(@order) {
        my $idx = pop @order;
        next if ref $idx;
        return $idx;
    }

    return undef; # No indexes
}

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

    my $top = $self->top_index;

    croak "elements must be added in order!"
        if $top && $idx && $idx <= $top;

    $idx = defined($top) ? $top + 1 : 0
        unless defined($idx);

    push @{$self->{+ORDER}} => $idx;
    $self->{+ITEMS}->{$idx} = $check;
}

sub add_filter {
    my $self = shift;
    my ($code) = @_;
    croak "A single coderef is required"
        unless @_ == 1 && $code && ref $code && reftype($code) eq 'CODE';

    push @{$self->{+ORDER}} => $code;
}

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

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

    my @deltas;
    my $state = 0;
    my @order = @{$self->{+ORDER}};
    my $items = $self->{+ITEMS};
    my $for_each = $self->{+FOR_EACH};

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

    # Make a copy that we can munge as needed.
    my @list = @$got;

    while (@order) {
        my $idx = shift @order;
        my $overflow = 0;
        my $val;

        # We have a filter, not an index
        if (ref($idx)) {
            @list = $idx->(@list);
            next;
        }

        confess "Internal Error: Stacks are out of sync (state > idx)"
            if $state > $idx + 1;

        while ($state <= $idx) {
            $overflow = !@list;
            $val = shift @list;

            # check-all goes here so we hit each item, even unspecified ones.
            for my $check (@$for_each) {
                $check = $convert->($check);
                push @deltas => $check->run(
                    id      => [ARRAY => $state],
                    convert => $convert,
                    seen    => $seen,
                    exists  => !$overflow,
                    $overflow ? () : (got => $val),
                );
            }

            $state++;
        }

        confess "Internal Error: Stacks are out of sync (state != idx + 1)"
            unless $state == $idx + 1;

        my $check = $convert->($items->{$idx});

        push @deltas => $check->run(
            id      => [ARRAY => $idx],
            convert => $convert,
            seen    => $seen,
            exists  => !$overflow,
            $overflow ? () : (got => $val),
        );
    }

    while (@list && (@$for_each || $self->{+ENDING})) {
        my $item = shift @list;

        for my $check (@$for_each) {
            $check = $convert->($check);
            push @deltas => $check->run(
                id      => [ARRAY => $state],
                convert => $convert,
                seen    => $seen,
                got     => $item,
                exists  => 1,
            );
        }

        # if items are left over, and ending is true, we have a problem!
        if ($self->{+ENDING}) {
            push @deltas => $self->delta_class->new(
                dne      => 'check',
                verified => undef,
                id       => [ARRAY => $state],
                got      => $item,
                check    => undef,

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

        $state++;
    }

    return @deltas;
}

1;

__END__