line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
18
|
|
|
18
|
|
776
|
use v5.14; |
|
18
|
|
|
|
|
80
|
|
2
|
18
|
|
|
18
|
|
118
|
use warnings; |
|
18
|
|
|
|
|
113
|
|
|
18
|
|
|
|
|
894
|
|
3
|
|
|
|
|
|
|
|
4
|
|
|
|
|
|
|
package Test::BDD::Cucumber::Model::TagSpec 0.85; |
5
|
|
|
|
|
|
|
|
6
|
|
|
|
|
|
|
=head1 NAME |
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
Test::BDD::Cucumber::Model::TagSpec - Encapsulates tag selectors |
9
|
|
|
|
|
|
|
|
10
|
|
|
|
|
|
|
=head1 VERSION |
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
version 0.85 |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
=head1 STATUS |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
DEPRECATED - This module's functionality has been superseeded by |
17
|
|
|
|
|
|
|
L. A module published by the Cucumber |
18
|
|
|
|
|
|
|
project, with cross-implementation tests to achieve overall consistency. |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
=head1 DESCRIPTION |
21
|
|
|
|
|
|
|
|
22
|
|
|
|
|
|
|
Try and deal with the crazy-sauce tagging mechanism in a sane |
23
|
|
|
|
|
|
|
way. |
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
=cut |
26
|
|
|
|
|
|
|
|
27
|
18
|
|
|
18
|
|
168
|
use Moo; |
|
18
|
|
|
|
|
49
|
|
|
18
|
|
|
|
|
112
|
|
28
|
18
|
|
|
18
|
|
6527
|
use List::Util qw( all any ); |
|
18
|
|
|
|
|
60
|
|
|
18
|
|
|
|
|
1747
|
|
29
|
18
|
|
|
18
|
|
169
|
use Types::Standard qw( ArrayRef ); |
|
18
|
|
|
|
|
67
|
|
|
18
|
|
|
|
|
155
|
|
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
=head1 OVERVIEW |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
Cucumber tags are all sortsa crazy. This appears to be a direct result of trying |
34
|
|
|
|
|
|
|
to shoe-horn the syntax in to something you can use on the command line. Because |
35
|
|
|
|
|
|
|
'Cucumber' is the name of a gem, application, language, methodology etc etc etc |
36
|
|
|
|
|
|
|
look of disapproval. |
37
|
|
|
|
|
|
|
|
38
|
|
|
|
|
|
|
Here is some further reading on how it's meant to work: |
39
|
|
|
|
|
|
|
L. This is obviously a little |
40
|
|
|
|
|
|
|
insane. |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
Here's how they work here, on a code level: You pass in a list of lists that |
43
|
|
|
|
|
|
|
look like Lisp expressions, with a function: C, C, or C. You can |
44
|
|
|
|
|
|
|
nest these to infinite complexity, but the parser is pretty inefficient, so |
45
|
|
|
|
|
|
|
don't do that. The C function accepts only one argument. |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
I: |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
@important AND @billing: C<<[and => 'important', 'billing']>> |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
(@billing OR @WIP) AND @important: C<<[ and => [ or => 'billing', 'wip' ], 'important' ]>> |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
Skipping both @todo and @wip tags: C<<[ and => [ not => 'todo' ], [ not => 'wip' ] ]>> |
54
|
|
|
|
|
|
|
|
55
|
|
|
|
|
|
|
=head1 ATTRIBUTES |
56
|
|
|
|
|
|
|
|
57
|
|
|
|
|
|
|
=head2 tags |
58
|
|
|
|
|
|
|
|
59
|
|
|
|
|
|
|
An arrayref representing a structure like the above. |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
TagSet->new({ |
62
|
|
|
|
|
|
|
tags => [ and => 'green', 'blue', [ or => 'red', 'yellow' ], [ not => 'white' ] ] |
63
|
|
|
|
|
|
|
}) |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
=cut |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
has 'tags' => ( is => 'rw', isa => ArrayRef, default => sub { [] } ); |
68
|
|
|
|
|
|
|
|
69
|
|
|
|
|
|
|
=head1 METHODS |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
=head2 filter |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
Filter a list of Scenarios by the value of C |
74
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
my @matched = $tagset->filter( @scenarios ); |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
If C is empty, no filtering is done. |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
=cut |
80
|
|
|
|
|
|
|
|
81
|
|
|
|
|
|
|
sub filter { |
82
|
13
|
|
|
13
|
1
|
6793
|
my ( $self, @scenarios ) = @_; |
83
|
13
|
50
|
|
|
|
26
|
return @scenarios unless @{ $self->tags }; |
|
13
|
|
|
|
|
247
|
|
84
|
|
|
|
|
|
|
|
85
|
|
|
|
|
|
|
return grep { |
86
|
13
|
|
|
|
|
145
|
my @tags = @{ $_->tags }; |
|
60
|
|
|
|
|
106
|
|
|
60
|
|
|
|
|
998
|
|
87
|
60
|
|
|
|
|
441
|
my $scenario = { map { $_ => 1 } @tags }; |
|
143
|
|
|
|
|
366
|
|
88
|
|
|
|
|
|
|
|
89
|
60
|
|
|
|
|
1028
|
_matches( $scenario, $self->tags ); |
90
|
|
|
|
|
|
|
} @scenarios; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
sub _matches { |
94
|
112
|
|
|
112
|
|
461
|
my ( $scenario, $tagspec ) = @_; |
95
|
112
|
|
|
|
|
244
|
my ( $mode, @tags ) = @$tagspec; |
96
|
|
|
|
|
|
|
|
97
|
112
|
100
|
|
|
|
250
|
if ( $mode eq 'and' ) { |
|
|
100
|
|
|
|
|
|
|
|
50
|
|
|
|
|
|
98
|
|
|
|
|
|
|
return all { |
99
|
81
|
100
|
|
81
|
|
349
|
ref $_ ? _matches( $scenario, $_ ) : $scenario->{$_} |
100
|
59
|
|
|
|
|
233
|
} @tags; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
elsif ( $mode eq 'or' ) { |
103
|
|
|
|
|
|
|
return any { |
104
|
46
|
100
|
|
46
|
|
212
|
ref $_ ? _matches( $scenario, $_ ) : $scenario->{$_} |
105
|
27
|
|
|
|
|
97
|
} @tags; |
106
|
|
|
|
|
|
|
} |
107
|
|
|
|
|
|
|
elsif ( $mode eq 'not' ) { |
108
|
26
|
50
|
|
|
|
66
|
die "'not' expects exactly one tag argument; found @tags" |
109
|
|
|
|
|
|
|
unless @tags == 1; |
110
|
|
|
|
|
|
|
|
111
|
|
|
|
|
|
|
return |
112
|
|
|
|
|
|
|
not (ref $tags[0] |
113
|
|
|
|
|
|
|
? _matches( $scenario, $tags[0] ) |
114
|
26
|
100
|
|
|
|
131
|
: $scenario->{$tags[0]} |
115
|
|
|
|
|
|
|
); |
116
|
|
|
|
|
|
|
} |
117
|
|
|
|
|
|
|
else { |
118
|
0
|
|
|
|
|
|
die "Unexpected tagspec operator '$mode'"; |
119
|
|
|
|
|
|
|
} |
120
|
|
|
|
|
|
|
} |
121
|
|
|
|
|
|
|
|
122
|
|
|
|
|
|
|
1; |