line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Test::Some; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:YANICK'; |
3
|
|
|
|
|
|
|
# ABSTRACT: test a subset of tests |
4
|
|
|
|
|
|
|
$Test::Some::VERSION = '0.2.1'; |
5
|
8
|
|
|
8
|
|
18700
|
use 5.10.0; |
|
8
|
|
|
|
|
19
|
|
6
|
|
|
|
|
|
|
|
7
|
8
|
|
|
8
|
|
32
|
use strict; |
|
8
|
|
|
|
|
11
|
|
|
8
|
|
|
|
|
137
|
|
8
|
8
|
|
|
8
|
|
21
|
use warnings; |
|
8
|
|
|
|
|
7
|
|
|
8
|
|
|
|
|
150
|
|
9
|
|
|
|
|
|
|
|
10
|
8
|
|
|
8
|
|
4056
|
use Test::More; |
|
8
|
|
|
|
|
96268
|
|
|
8
|
|
|
|
|
60
|
|
11
|
|
|
|
|
|
|
|
12
|
8
|
|
|
8
|
|
6454
|
use List::MoreUtils qw/ none any /; |
|
8
|
|
|
|
|
58757
|
|
|
8
|
|
|
|
|
41
|
|
13
|
8
|
|
|
8
|
|
7056
|
use Package::Stash; |
|
8
|
|
|
|
|
43374
|
|
|
8
|
|
|
|
|
1723
|
|
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
our %filters; |
16
|
|
|
|
|
|
|
|
17
|
|
|
|
|
|
|
our $BYPASS = 0; |
18
|
|
|
|
|
|
|
|
19
|
|
|
|
|
|
|
my @init_namespaces; |
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
sub INIT { |
22
|
|
|
|
|
|
|
# delaying stuff to INIT |
23
|
|
|
|
|
|
|
# because Test::Some can be loaded before Test::More if used on the |
24
|
|
|
|
|
|
|
# prompt |
25
|
|
|
|
|
|
|
|
26
|
8
|
|
|
8
|
|
39
|
for my $caller ( keys %filters ) { |
27
|
8
|
50
|
|
|
|
108
|
my $original_subtest = $caller->can('subtest') |
28
|
|
|
|
|
|
|
or die "no function 'subtest' found in package $caller. Forgot to import Test::More?"; |
29
|
|
|
|
|
|
|
|
30
|
8
|
|
|
|
|
201
|
Package::Stash->new($caller)->add_symbol( '&subtest' => |
31
|
|
|
|
|
|
|
_subtest_maker( $original_subtest, $caller ) |
32
|
|
|
|
|
|
|
); |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
} |
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
sub import { |
37
|
8
|
|
|
8
|
|
134
|
my $caller = caller; |
38
|
8
|
|
|
|
|
18
|
my(undef,@filters) = @_; |
39
|
|
|
|
|
|
|
|
40
|
8
|
|
|
8
|
|
44
|
no warnings 'uninitialized'; |
|
8
|
|
|
|
|
63
|
|
|
8
|
|
|
|
|
3514
|
|
41
|
8
|
100
|
|
|
|
32
|
@filters = split ',', $ENV{TEST_SOME} unless @filters; |
42
|
|
|
|
|
|
|
|
43
|
8
|
|
|
|
|
26
|
_groom_filter($caller,$_) for @filters; |
44
|
|
|
|
|
|
|
|
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
sub _groom_filter { |
48
|
34
|
|
|
34
|
|
43
|
my( $caller, $filter, $is_tag, $is_negated ) = @_; |
49
|
|
|
|
|
|
|
|
50
|
34
|
100
|
|
|
|
67
|
return $BYPASS = 1 if $filter eq '~'; |
51
|
|
|
|
|
|
|
|
52
|
31
|
100
|
|
|
|
86
|
return _groom_filter( $caller, $filter, 1, $is_negated ) |
53
|
|
|
|
|
|
|
if $filter =~ s/^://; |
54
|
|
|
|
|
|
|
|
55
|
26
|
100
|
|
|
|
70
|
return _groom_filter( $caller, $filter, $is_tag, 1 ) |
56
|
|
|
|
|
|
|
if $filter =~ s/^!//; |
57
|
|
|
|
|
|
|
|
58
|
23
|
100
|
|
|
|
121
|
return _groom_filter( $caller, qr/$filter/, $is_tag, $is_negated ) |
59
|
|
|
|
|
|
|
if $filter =~ s#^/##; |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
my $sub = ref $filter eq 'CODE' ? $filter |
62
|
|
|
|
|
|
|
: $is_tag ? sub { |
63
|
3
|
|
|
|
|
23
|
return ref $filter ? any { /$filter/ } keys %_ |
64
|
13
|
100
|
|
13
|
|
104
|
: $_{$filter}; |
65
|
|
|
|
|
|
|
} |
66
|
16
|
100
|
|
30
|
|
81
|
: sub { ref $filter ? /$filter/ : $_ eq $filter }; |
|
30
|
100
|
|
|
|
195
|
|
|
|
100
|
|
|
|
|
|
67
|
|
|
|
|
|
|
|
68
|
16
|
100
|
|
|
|
27
|
if( $is_negated ) { |
69
|
3
|
|
|
|
|
4
|
my $prev_sub = $sub; |
70
|
3
|
|
|
5
|
|
5
|
$sub = sub { not $prev_sub->() }; |
|
5
|
|
|
|
|
9
|
|
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
16
|
|
|
|
|
16
|
push @{ $filters{$caller} }, $sub; |
|
16
|
|
|
|
|
1300
|
|
74
|
|
|
|
|
|
|
} |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
sub _should_be_skipped { |
77
|
26
|
|
|
26
|
|
33
|
my( $caller, $name, @tags ) = @_; |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
return none { |
80
|
46
|
|
|
46
|
|
46
|
my $filter = $_; |
81
|
|
|
|
|
|
|
{ |
82
|
46
|
|
|
|
|
34
|
local( $_, %_ ) = ( $name, map { $_ => 1 } @tags ); |
|
46
|
|
|
|
|
69
|
|
|
21
|
|
|
|
|
51
|
|
83
|
46
|
|
|
|
|
71
|
$filter->(); |
84
|
|
|
|
|
|
|
} |
85
|
26
|
|
|
|
|
93
|
} eval { @{ $filters{$caller} } }; |
|
26
|
|
|
|
|
21
|
|
|
26
|
|
|
|
|
133
|
|
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
sub _subtest_maker { |
90
|
8
|
|
|
8
|
|
16
|
my( $orig, $caller ) = @_; |
91
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
return sub { |
93
|
26
|
|
|
26
|
|
21914
|
my ( $name, $code, @tags ) = @_; |
94
|
|
|
|
|
|
|
|
95
|
26
|
100
|
|
|
|
57
|
if( _should_be_skipped($caller,$name,@tags) ) { |
96
|
7
|
100
|
|
|
|
149
|
return if $BYPASS; |
97
|
|
|
|
|
|
|
$code = sub { |
98
|
4
|
|
|
4
|
|
1399
|
Test::More::plan( skip_all => 'Test::Some skipping' ); |
99
|
|
|
|
|
|
|
$orig->($name, sub { } ) |
100
|
0
|
|
|
|
|
0
|
} |
101
|
4
|
|
|
|
|
27
|
} |
102
|
|
|
|
|
|
|
|
103
|
23
|
|
|
|
|
136
|
$orig->( $name, $code ); |
104
|
|
|
|
|
|
|
} |
105
|
8
|
|
|
|
|
184
|
} |
106
|
|
|
|
|
|
|
|
107
|
|
|
|
|
|
|
1; |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
__END__ |