File Coverage

blib/lib/HTML/Tested/Test/List.pm
Criterion Covered Total %
statement 44 44 100.0
branch 9 12 75.0
condition 5 9 55.5
subroutine 9 9 100.0
pod 0 4 0.0
total 67 78 85.9


line stmt bran cond sub pod time code
1 17     17   114 use strict;
  17         33  
  17         815  
2 17     17   98 use warnings FATAL => 'all';
  17         35  
  17         1017  
3              
4             package HTML::Tested::Test::List;
5 17     17   110 use Carp;
  17         43  
  17         1411  
6 17     17   25013 use Math::Combinatorics;
  17         98236  
  17         16634  
7              
8             sub _comp_stashes {
9 15     15   214 my ($class, $er_arr, $r_arr, $e_arr) = @_;
10 15         24 my @err;
11 15   66     56 for (my $i = 0; $i < @$r_arr || $i < @$e_arr; $i++) {
12 30         169 push @err, HTML::Tested::Test->compare_stashes(
13             $er_arr->[$i], $r_arr->[$i], $e_arr->[$i]);
14             }
15 15         295 return @err;
16             }
17              
18             sub check_stash {
19 13     13 0 27 my ($class, $e_root, $name, $e_stash, $r_stash) = @_;
20 13         16 my @err;
21 13 50       43 goto OUT unless exists($e_stash->{$name});
22              
23 13         24 my $e_arr = $e_stash->{$name};
24 13         64 my $r_arr = HTML::Tested::Test::Ensure_Value_To_Check(
25             $r_stash, $name, $e_arr, \@err);
26 13 50 33     79 return @err if (!defined($r_arr) || @err);
27 13 100       68 return $class->_comp_stashes($e_root->$name, $r_arr, $e_arr)
28             unless $e_root->{"__HT_UNSORTED__$name"};
29              
30 3         20 my @rrs = permute(@$r_arr);
31 3         540 for (my $i = 0; $i < @rrs; $i++) {
32 5         33 @err = $class->_comp_stashes($e_root->$name, $rrs[$i], $e_arr);
33 5 100       51 return () if !@err;
34             }
35 1         15 return @err;
36             };
37              
38             sub check_text {
39 4     4 0 10 my ($class, $e_root, $name, $e_stash, $text) = @_;
40 4 50       15 return () unless exists $e_stash->{$name};
41 4         9 my $expected = $e_stash->{$name};
42 4         15 my @err;
43 4         15 for (my $i = 0; $i < @$expected; $i++) {
44 8         28 push @err, HTML::Tested::Test->compare_text_to_stash(
45             $e_root->$name->[$i],
46             $text, $expected->[$i]);
47             }
48 4         26 return @err;
49             }
50              
51             sub bless_from_tree {
52 19     19 0 41 my ($class, $w_class, $p, $err) = @_;
53 19         72 my $target = $w_class->containee;
54 19 100 66     140 confess $w_class->name . " should be ARRAY reference"
55             unless ($p && ref($p) eq 'ARRAY');
56 18         43 return [ map { HTML::Tested::Test->bless_from_tree_for_test($target
  34         132  
57             , $_, $err); } @$p ];
58             }
59              
60             sub convert_to_param {
61 3     3 0 9 my ($class, $obj_class, $r, $name, $val) = @_;
62 3         14 my $c = $obj_class->containee;
63             HTML::Tested::Test->convert_tree_to_param(
64 3         38 $c, $r, $val->[$_ - 1], $name . "__$_") for (1 .. @$val);
65             }
66              
67             1;