File Coverage

blib/lib/Test2/Compare/OrderedSubset.pm
Criterion Covered Total %
statement 58 58 100.0
branch 17 18 94.4
condition 2 2 100.0
subroutine 11 11 100.0
pod 4 5 80.0
total 92 94 97.8


line stmt bran cond sub pod time code
1             package Test2::Compare::OrderedSubset;
2 169     169   1222 use strict;
  169         357  
  169         5295  
3 169     169   923 use warnings;
  169         354  
  169         4826  
4              
5 169     169   891 use base 'Test2::Compare::Base';
  169         443  
  169         18304  
6              
7             our $VERSION = '0.000156';
8              
9 169     169   1247 use Test2::Util::HashBase qw/inref items/;
  169         356  
  169         1108  
10              
11 169     169   30058 use Carp qw/croak/;
  169         381  
  169         9462  
12 169     169   1160 use Scalar::Util qw/reftype/;
  169         433  
  169         91848  
13              
14             sub init {
15 38     38 0 1540 my $self = shift;
16              
17 38 100       141 if(my $ref = $self->{+INREF}) {
18 3 50       10 croak "Cannot specify both 'inref' and 'items'" if $self->{+ITEMS};
19 3 100       307 croak "'inref' must be an array reference, got '$ref'" unless reftype($ref) eq 'ARRAY';
20 2         12 $self->{+ITEMS} = [@{$self->{+INREF}}];
  2         10  
21             }
22              
23 37   100     190 $self->{+ITEMS} ||= [];
24              
25 37         144 $self->SUPER::init();
26             }
27              
28 1     1 1 20 sub name { '' }
29              
30             sub verify {
31 38     38 1 81 my $self = shift;
32 38         119 my %params = @_;
33              
34 38 100       125 return 0 unless $params{exists};
35 37 100       114 defined( my $got = $params{got} ) || return 0;
36 36 100       103 return 0 unless ref($got);
37 33 100       146 return 0 unless reftype($got) eq 'ARRAY';
38 32         97 return 1;
39             }
40              
41             sub add_item {
42 53     53 1 123 my $self = shift;
43 53         80 my $check = pop;
44              
45 53         80 push @{$self->{+ITEMS}} => $check;
  53         221  
46             }
47              
48             sub deltas {
49 35     35 1 86 my $self = shift;
50 35         110 my %params = @_;
51 35         108 my ($got, $convert, $seen) = @params{qw/got convert seen/};
52              
53 35         53 my @deltas;
54 35         57 my $state = 0;
55 35         77 my $items = $self->{+ITEMS};
56              
57 35         71 my $idx = 0;
58              
59 35         97 for my $item (@$items) {
60 56         142 my $check = $convert->($item);
61              
62 56         155 my $i = $idx;
63 56         84 my $found;
64 56         198 while($i < @$got) {
65 57         148 my $val = $got->[$i++];
66 57 100       217 next if $check->run(
67             id => [ARRAY => $i],
68             convert => $convert,
69             seen => $seen,
70             exists => 1,
71             got => $val,
72             );
73              
74 54         133 $idx = $i;
75 54         157 $found++;
76 54         99 last;
77             }
78              
79 56 100       164 next if $found;
80              
81 2         12 push @deltas => Test2::Compare::Delta->new(
82             verified => 0,
83             id => ['ARRAY', '?'],
84             check => $check,
85             dne => 'got',
86             );
87             }
88              
89 35         150 return @deltas;
90             }
91              
92             1;
93              
94             __END__