File Coverage

blib/lib/Module/Setup/Test/Flavor.pm
Criterion Covered Total %
statement 97 97 100.0
branch 14 14 100.0
condition n/a
subroutine 18 18 100.0
pod 0 7 0.0
total 129 136 94.8


line stmt bran cond sub pod time code
1             package Module::Setup::Test::Flavor;
2 2     2   1951 use Module::Setup::Test::Utils;
  2         7  
  2         19  
3 2     2   16 use Carp ();
  2         3  
  2         44  
4 2     2   12 use File::Find::Rule;
  2         2  
  2         28  
5 2     2   1539 use Test::More;
  2         9  
  2         23  
6              
7             sub import {
8 2     2   18 my $class = shift;
9 2         4 my $caller = caller;
10 2         5 my %args = @_;
11              
12 2 100       11 if ($args{for_test}) {
13 2     2   15 no strict 'refs';
  2         169  
  2         97  
14 2     2   11 no warnings 'redefine';
  2         3  
  2         252  
15 1     48   7 *ok = sub ($;$) { 1 };
  48         5392  
16 1     9   4 *like = sub ($$;$) { 1 };
  9         20  
17 1     5   5 *plan = sub {};
18             }
19              
20 2         3 for my $func (qw/ run_flavor_test name flavor files file dirs options default_dialog dialog /) {
21 2     2   9 no strict 'refs';
  2         3  
  2         1631  
22 18         14 *{"$caller\::$func"} = \&{ $func };
  18         55  
  18         25  
23             }
24              
25 2         12 strict->import;
26 2         1678 warnings->import;
27             }
28              
29             my $tests = {};
30             sub name ($) {
31 4     4 0 27 $tests->{module} = shift;
32             }
33             sub flavor ($) {
34 1     1 0 5 $tests->{flavor_class} = shift;
35             }
36              
37             sub files (@) {
38 5     5 0 25 push @{ $tests->{files} }, @_;
  5         33  
39             }
40              
41             sub file (@) {
42 12     12 0 75 my $file = shift;
43 12         13 push @{ $tests->{files} }, {
  12         59  
44             file => $file,
45             likes => [ @_ ],
46             };
47             }
48              
49             sub dirs (@) {
50 5     5 0 22 push @{ $tests->{dirs} }, @_;
  5         19  
51             }
52              
53             sub options ($) {
54 1     1 0 8 $tests->{options} = shift;
55             }
56              
57              
58             sub run_flavor_test (&) {
59 6     6 0 80 my $code = shift;
60 6         47 $tests = {
61             module => 'Default',
62             files => [],
63             dirs => [],
64             options => {},
65             flavor_class => 'Default',
66             };
67 6         40 $code->();
68 6         18 my $module = delete $tests->{module};
69 6         12 my $options = delete $tests->{options};
70 6         17 $options->{target} = 1;
71 6         16 $options->{flavor_class} = delete $tests->{flavor_class};
72              
73             # test count
74 6         10 my $count = 2;
75 6         12 $count += scalar(@{ $tests->{dirs} });
  6         12  
76 6         9 for my $test (@{ $tests->{files} }) {
  6         19  
77 44         30 $count++;
78 44 100       84 if (ref($test) eq 'HASH') {
79 12         15 $count += @{ $test->{likes} };
  12         22  
80             }
81             }
82              
83 6         26 plan tests => $count;
84 6         27 module_setup $options, $module;
85              
86 6         33 my $base_path = context->distribute->dist_path;
87 6         32 ok -d $base_path, 'base_path';
88              
89 6         77 my %files = map { $_ => 1 } File::Find::Rule->new->relative->in( context->distribute->dist_path );
  84         9729  
90              
91 6         39 for my $path (@{ $tests->{dirs} }) {
  6         28  
92 12 100       249 Carp::croak "$path directory was missing" unless $files{$path};
93 11         56 my $dir = $base_path->subdir( split '/', $path );
94 11         484 ok -d $dir, "dir: $dir";
95 11         1934 delete $files{$path};
96             }
97              
98 5         10 for my $data (@{ $tests->{files} }) {
  5         22  
99 44         67 my $likes = [];
100 44         53 my $path = $data;
101 44 100       102 if (ref($data) eq 'HASH') {
102 12         27 $path = $data->{file};
103 12         19 $likes = $data->{likes};
104             }
105 44 100       252 Carp::croak "$path file was missing" unless $files{$path};
106 43         169 my $file = $base_path->file( split '/', $path );
107 43         2834 ok -f $file, "file: $file";
108              
109 43 100       78 if (@{ $likes }) {
  43         98  
110 12         44 my $slurp = $file->slurp;
111 12         2136 for my $re (@{ $likes }) {
  12         31  
112 13         60 like $slurp, $re, "like $re";
113             }
114             }
115              
116 43         208 delete $files{$path};
117             }
118              
119 4         15 my $is_ok = !scalar(keys %files);
120 4         12 ok $is_ok, "is all ok";
121 4 100       18 unless ($is_ok) {
122 2         11 my $files = join ', ', keys %files;
123 2         464 Carp::croak "missing tests for $files";
124             }
125              
126 2         47 return 1;
127             }
128              
129              
130             1;
131              
132             =head1 NAME
133              
134             Module::Setup::Test::Flavor - Test for flavor
135              
136             =cut
137              
138