line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package SmokeRunner::Multi::TestSet; |
2
|
|
|
|
|
|
|
our $AUTHORITY = 'cpan:YANICK'; |
3
|
|
|
|
|
|
|
#ABSTRACT: Represents a set of tests |
4
|
|
|
|
|
|
|
$SmokeRunner::Multi::TestSet::VERSION = '0.20'; |
5
|
7
|
|
|
7
|
|
56169
|
use strict; |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
183
|
|
6
|
7
|
|
|
7
|
|
35
|
use warnings; |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
268
|
|
7
|
|
|
|
|
|
|
|
8
|
7
|
|
|
7
|
|
34
|
use base 'Class::Accessor::Fast'; |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
2740
|
|
9
|
|
|
|
|
|
|
__PACKAGE__->mk_ro_accessors( qw( name set_dir test_dir last_run_time is_prioritized ) ); |
10
|
|
|
|
|
|
|
|
11
|
7
|
|
|
7
|
|
15032
|
use Class::Factory::Util; |
|
7
|
|
|
|
|
4051
|
|
|
7
|
|
|
|
|
56
|
|
12
|
7
|
|
|
7
|
|
253
|
use File::Basename qw( basename ); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
449
|
|
13
|
7
|
|
|
7
|
|
4819
|
use File::Find::Rule; |
|
7
|
|
|
|
|
51655
|
|
|
7
|
|
|
|
|
48
|
|
14
|
7
|
|
|
7
|
|
415
|
use File::Path qw( rmtree ); |
|
7
|
|
|
|
|
13
|
|
|
7
|
|
|
|
|
384
|
|
15
|
7
|
|
|
7
|
|
33
|
use File::Spec; |
|
7
|
|
|
|
|
25
|
|
|
7
|
|
|
|
|
162
|
|
16
|
7
|
|
|
7
|
|
33
|
use List::Util qw( max ); |
|
7
|
|
|
|
|
12
|
|
|
7
|
|
|
|
|
559
|
|
17
|
7
|
|
|
7
|
|
4124
|
use SmokeRunner::Multi::DBI; |
|
7
|
|
|
|
|
22
|
|
|
7
|
|
|
|
|
267
|
|
18
|
7
|
|
|
7
|
|
1737
|
use SmokeRunner::Multi::Validate qw( validate DIR_TYPE ); |
|
7
|
|
|
|
|
17
|
|
|
7
|
|
|
|
|
63
|
|
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
BEGIN |
22
|
|
|
|
|
|
|
{ |
23
|
7
|
|
|
7
|
|
55
|
for my $subclass ( map { __PACKAGE__ . '::' . $_ } __PACKAGE__->subclasses() ) |
|
7
|
|
|
|
|
3633
|
|
24
|
|
|
|
|
|
|
{ |
25
|
7
|
50
|
|
|
|
478
|
eval "require $subclass" or die $@; |
26
|
|
|
|
|
|
|
} |
27
|
|
|
|
|
|
|
} |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
{ |
30
|
|
|
|
|
|
|
my $spec = { set_dir => DIR_TYPE }; |
31
|
|
|
|
|
|
|
sub new |
32
|
|
|
|
|
|
|
{ |
33
|
48
|
|
|
48
|
1
|
20354
|
my $class = shift; |
34
|
48
|
|
|
|
|
1236
|
my %p = validate( @_, $spec ); |
35
|
|
|
|
|
|
|
|
36
|
48
|
|
|
|
|
623
|
my $test_dir = File::Spec->catdir( $p{set_dir}, 't' ); |
37
|
48
|
100
|
|
|
|
1204
|
die "A test set's directory must have a 't' subdirectory" |
38
|
|
|
|
|
|
|
unless -d $test_dir; |
39
|
|
|
|
|
|
|
|
40
|
|
|
|
|
|
|
my %subclass_p = ( %p, |
41
|
46
|
|
|
|
|
2183
|
name => basename( $p{set_dir} ), |
42
|
|
|
|
|
|
|
test_dir => $test_dir, |
43
|
|
|
|
|
|
|
dbh => SmokeRunner::Multi::DBI::handle(), |
44
|
|
|
|
|
|
|
); |
45
|
|
|
|
|
|
|
|
46
|
46
|
|
|
|
|
128
|
my $self; |
47
|
46
|
|
|
|
|
522
|
for my $subclass ( map { __PACKAGE__ . '::' . $_ } $class->subclasses() ) |
|
46
|
|
|
|
|
28184
|
|
48
|
|
|
|
|
|
|
{ |
49
|
46
|
|
|
|
|
499
|
$self = $subclass->_new(%subclass_p); |
50
|
|
|
|
|
|
|
} |
51
|
|
|
|
|
|
|
|
52
|
46
|
|
66
|
|
|
380
|
$self ||= __PACKAGE__->_new(%subclass_p); |
53
|
|
|
|
|
|
|
|
54
|
46
|
|
|
|
|
222
|
$self->_instantiate_in_db(); |
55
|
46
|
|
|
|
|
244182
|
$self->_get_db_data(); |
56
|
|
|
|
|
|
|
|
57
|
46
|
|
|
|
|
1299
|
return $self; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
sub _new |
62
|
|
|
|
|
|
|
{ |
63
|
43
|
|
|
43
|
|
108
|
my $class = shift; |
64
|
|
|
|
|
|
|
|
65
|
43
|
|
|
|
|
493
|
return bless { @_ }, $class; |
66
|
|
|
|
|
|
|
} |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub _instantiate_in_db |
69
|
|
|
|
|
|
|
{ |
70
|
46
|
|
|
46
|
|
101
|
my $self = shift; |
71
|
|
|
|
|
|
|
|
72
|
46
|
|
|
|
|
100
|
my $insert_sql = 'INSERT OR IGNORE INTO TestSet (name) VALUES (?)'; |
73
|
|
|
|
|
|
|
|
74
|
46
|
|
|
|
|
270
|
$self->{dbh}->do( $insert_sql, {}, $self->name() ); |
75
|
|
|
|
|
|
|
} |
76
|
|
|
|
|
|
|
|
77
|
|
|
|
|
|
|
sub _get_db_data |
78
|
|
|
|
|
|
|
{ |
79
|
55
|
|
|
55
|
|
192
|
my $self = shift; |
80
|
|
|
|
|
|
|
|
81
|
55
|
|
|
|
|
150
|
my $select_sql = 'SELECT last_run_time, is_prioritized FROM TestSet WHERE name = ?'; |
82
|
|
|
|
|
|
|
|
83
|
55
|
|
|
|
|
11923
|
@{ $self }{ qw( last_run_time is_prioritized ) } = |
84
|
55
|
|
|
|
|
397
|
$self->{dbh}->selectrow_array( $select_sql, {}, $self->name() ); |
85
|
|
|
|
|
|
|
} |
86
|
|
|
|
|
|
|
|
87
|
|
|
|
|
|
|
sub test_files |
88
|
|
|
|
|
|
|
{ |
89
|
36
|
|
|
36
|
1
|
2904
|
my $self = shift; |
90
|
|
|
|
|
|
|
|
91
|
36
|
|
|
|
|
1623
|
return sort File::Find::Rule->file()->name( '*.t' )->in( $self->test_dir() ); |
92
|
|
|
|
|
|
|
} |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
sub last_mod_time |
95
|
|
|
|
|
|
|
{ |
96
|
56
|
|
|
56
|
1
|
1091
|
my $self = shift; |
97
|
|
|
|
|
|
|
|
98
|
56
|
100
|
|
|
|
253
|
return $self->{last_mod_time} if exists $self->{last_mod_time}; |
99
|
|
|
|
|
|
|
|
100
|
30
|
|
100
|
|
|
91
|
$self->{last_mod_time} = $self->_last_mod_time() || 0; |
101
|
|
|
|
|
|
|
|
102
|
30
|
|
|
|
|
2536
|
return $self->{last_mod_time}; |
103
|
|
|
|
|
|
|
} |
104
|
|
|
|
|
|
|
|
105
|
|
|
|
|
|
|
sub _last_mod_time |
106
|
|
|
|
|
|
|
{ |
107
|
29
|
|
|
29
|
|
56
|
my $self = shift; |
108
|
|
|
|
|
|
|
|
109
|
29
|
|
|
|
|
87
|
return max map { ( stat $_ )[9] } $self->test_files(); |
|
62
|
|
|
|
|
30229
|
|
110
|
|
|
|
|
|
|
} |
111
|
|
|
|
|
|
|
|
112
|
|
|
|
|
|
|
sub is_out_of_date |
113
|
|
|
|
|
|
|
{ |
114
|
4
|
|
|
4
|
1
|
1832
|
my $self = shift; |
115
|
|
|
|
|
|
|
|
116
|
4
|
100
|
|
|
|
15
|
return $self->seconds_out_of_date() > 0 ? 1 : 0; |
117
|
|
|
|
|
|
|
} |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub seconds_out_of_date |
120
|
|
|
|
|
|
|
{ |
121
|
55
|
|
|
55
|
1
|
465
|
my $self = shift; |
122
|
|
|
|
|
|
|
|
123
|
55
|
|
|
|
|
156
|
return $self->last_mod_time() - $self->last_run_time(); |
124
|
|
|
|
|
|
|
} |
125
|
|
|
|
|
|
|
|
126
|
|
|
|
|
|
|
sub update_last_run_time |
127
|
|
|
|
|
|
|
{ |
128
|
3
|
|
|
3
|
1
|
381
|
my $self = shift; |
129
|
3
|
|
|
|
|
8
|
my $time = shift; |
130
|
|
|
|
|
|
|
|
131
|
3
|
|
|
|
|
11
|
my $update_sql = 'UPDATE TestSet SET last_run_time = ? WHERE name = ?'; |
132
|
|
|
|
|
|
|
|
133
|
3
|
|
|
|
|
27
|
$self->{dbh}->do( $update_sql, {}, $time, $self->name() ); |
134
|
|
|
|
|
|
|
|
135
|
3
|
|
|
|
|
37534
|
$self->_get_db_data(); |
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
sub prioritize |
139
|
|
|
|
|
|
|
{ |
140
|
4
|
|
|
4
|
1
|
770
|
my $self = shift; |
141
|
|
|
|
|
|
|
|
142
|
4
|
|
|
|
|
10
|
my $update_sql = 'UPDATE TestSet SET is_prioritized = ? WHERE name = ?'; |
143
|
|
|
|
|
|
|
|
144
|
4
|
|
|
|
|
23
|
$self->{dbh}->do( $update_sql, {}, 1, $self->name() ); |
145
|
|
|
|
|
|
|
|
146
|
4
|
|
|
|
|
38769
|
$self->_get_db_data(); |
147
|
|
|
|
|
|
|
} |
148
|
|
|
|
|
|
|
|
149
|
|
|
|
|
|
|
sub unprioritize |
150
|
|
|
|
|
|
|
{ |
151
|
2
|
|
|
2
|
1
|
695
|
my $self = shift; |
152
|
|
|
|
|
|
|
|
153
|
2
|
|
|
|
|
13
|
my $update_sql = 'UPDATE TestSet SET is_prioritized = ? WHERE name = ?'; |
154
|
|
|
|
|
|
|
|
155
|
2
|
|
|
|
|
23
|
$self->{dbh}->do( $update_sql, {}, 0, $self->name() ); |
156
|
|
|
|
|
|
|
|
157
|
2
|
|
|
|
|
14216
|
$self->_get_db_data(); |
158
|
|
|
|
|
|
|
} |
159
|
|
|
|
|
|
|
|
160
|
|
|
|
|
|
|
sub update_files |
161
|
|
|
|
|
|
|
{ |
162
|
1
|
|
|
1
|
1
|
4
|
return; |
163
|
|
|
|
|
|
|
} |
164
|
|
|
|
|
|
|
|
165
|
|
|
|
|
|
|
sub remove |
166
|
|
|
|
|
|
|
{ |
167
|
2
|
|
|
2
|
1
|
14
|
my $self = shift; |
168
|
|
|
|
|
|
|
|
169
|
2
|
|
|
|
|
6
|
my $delete_sql = 'DELETE FROM TestSet WHERE name = ?'; |
170
|
|
|
|
|
|
|
|
171
|
2
|
|
|
|
|
13
|
$self->{dbh}->do( $delete_sql, {}, $self->name() ); |
172
|
|
|
|
|
|
|
|
173
|
2
|
50
|
|
|
|
14975
|
rmtree( $self->set_dir(), 0, 0 ) |
174
|
|
|
|
|
|
|
or die "Cannot rmtree " . $self->set_dir() . "\n"; |
175
|
|
|
|
|
|
|
} |
176
|
|
|
|
|
|
|
|
177
|
|
|
|
|
|
|
sub All |
178
|
|
|
|
|
|
|
{ |
179
|
10
|
|
|
10
|
1
|
12714
|
my $class = shift; |
180
|
|
|
|
|
|
|
|
181
|
10
|
|
|
|
|
115
|
my $root_dir = SmokeRunner::Multi::Config->instance()->root_dir(); |
182
|
|
|
|
|
|
|
|
183
|
10
|
50
|
|
|
|
892
|
opendir my $dh, $root_dir |
184
|
|
|
|
|
|
|
or die "Cannot read $root_dir: $!"; |
185
|
|
|
|
|
|
|
|
186
|
|
|
|
|
|
|
return |
187
|
|
|
|
|
|
|
( sort _sort_sets |
188
|
33
|
100
|
|
|
|
80
|
map { eval { $class->new( set_dir => $_ ) } || () } |
|
33
|
|
|
|
|
152
|
|
189
|
52
|
|
|
|
|
1005
|
grep { -d } |
190
|
10
|
|
|
|
|
534
|
map { File::Spec->catdir( $root_dir, $_ ) } |
|
52
|
|
|
|
|
348
|
|
191
|
|
|
|
|
|
|
File::Spec->no_upwards( readdir $dh ) |
192
|
|
|
|
|
|
|
); |
193
|
|
|
|
|
|
|
} |
194
|
|
|
|
|
|
|
|
195
|
|
|
|
|
|
|
sub _sort_sets |
196
|
|
|
|
|
|
|
{ |
197
|
|
|
|
|
|
|
return |
198
|
30
|
|
66
|
30
|
|
366
|
( $b->is_prioritized() <=> $a->is_prioritized() |
199
|
|
|
|
|
|
|
or |
200
|
|
|
|
|
|
|
$b->seconds_out_of_date() <=> $a->seconds_out_of_date() |
201
|
|
|
|
|
|
|
or |
202
|
|
|
|
|
|
|
# This last clause simply ensures that the sort order is |
203
|
|
|
|
|
|
|
# unique and repeatable. |
204
|
|
|
|
|
|
|
$a->name() cmp $b->name() |
205
|
|
|
|
|
|
|
); |
206
|
|
|
|
|
|
|
} |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
|
209
|
|
|
|
|
|
|
1; |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
__END__ |