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 168     168   1178 use strict;
  168         376  
  168         5063  
3 168     168   846 use warnings;
  168         370  
  168         4192  
4              
5 168     168   870 use base 'Test2::Compare::Base';
  168         378  
  168         17805  
6              
7             our $VERSION = '0.000153';
8              
9 168     168   1170 use Test2::Util::HashBase qw/inref items/;
  168         368  
  168         1077  
10              
11 168     168   29079 use Carp qw/croak/;
  168         365  
  168         8127  
12 168     168   1040 use Scalar::Util qw/reftype/;
  168         356  
  168         79428  
13              
14             sub init {
15 38     38 0 1432 my $self = shift;
16              
17 38 100       109 if(my $ref = $self->{+INREF}) {
18 3 50       14 croak "Cannot specify both 'inref' and 'items'" if $self->{+ITEMS};
19 3 100       233 croak "'inref' must be an array reference, got '$ref'" unless reftype($ref) eq 'ARRAY';
20 2         6 $self->{+ITEMS} = [@{$self->{+INREF}}];
  2         6  
21             }
22              
23 37   100     166 $self->{+ITEMS} ||= [];
24              
25 37         106 $self->SUPER::init();
26             }
27              
28 1     1 1 21 sub name { '' }
29              
30             sub verify {
31 38     38 1 83 my $self = shift;
32 38         90 my %params = @_;
33              
34 38 100       87 return 0 unless $params{exists};
35 37 100       83 defined( my $got = $params{got} ) || return 0;
36 36 100       92 return 0 unless ref($got);
37 33 100       109 return 0 unless reftype($got) eq 'ARRAY';
38 32         82 return 1;
39             }
40              
41             sub add_item {
42 53     53 1 86 my $self = shift;
43 53         64 my $check = pop;
44              
45 53         66 push @{$self->{+ITEMS}} => $check;
  53         152  
46             }
47              
48             sub deltas {
49 35     35 1 69 my $self = shift;
50 35         96 my %params = @_;
51 35         80 my ($got, $convert, $seen) = @params{qw/got convert seen/};
52              
53 35         57 my @deltas;
54 35         43 my $state = 0;
55 35         56 my $items = $self->{+ITEMS};
56              
57 35         46 my $idx = 0;
58              
59 35         73 for my $item (@$items) {
60 56         115 my $check = $convert->($item);
61              
62 56         150 my $i = $idx;
63 56         75 my $found;
64 56         162 while($i < @$got) {
65 57         126 my $val = $got->[$i++];
66 57 100       198 next if $check->run(
67             id => [ARRAY => $i],
68             convert => $convert,
69             seen => $seen,
70             exists => 1,
71             got => $val,
72             );
73              
74 54         111 $idx = $i;
75 54         79 $found++;
76 54         74 last;
77             }
78              
79 56 100       141 next if $found;
80              
81 2         23 push @deltas => Test2::Compare::Delta->new(
82             verified => 0,
83             id => ['ARRAY', '?'],
84             check => $check,
85             dne => 'got',
86             );
87             }
88              
89 35         117 return @deltas;
90             }
91              
92             1;
93              
94             __END__