Commit | Line | Data |
27fc0087 |
1 | package App::Prove::State::Result; |
2 | |
3 | use strict; |
4 | use Carp 'croak'; |
5 | |
6 | use App::Prove::State::Result::Test; |
7 | use vars qw($VERSION); |
8 | |
9 | use constant STATE_VERSION => 1; |
10 | |
11 | =head1 NAME |
12 | |
13 | App::Prove::State::Result - Individual test suite results. |
14 | |
15 | =head1 VERSION |
16 | |
a39e16d8 |
17 | Version 3.17 |
27fc0087 |
18 | |
19 | =cut |
20 | |
a39e16d8 |
21 | $VERSION = '3.17'; |
27fc0087 |
22 | |
23 | =head1 DESCRIPTION |
24 | |
25 | The C<prove> command supports a C<--state> option that instructs it to |
26 | store persistent state across runs. This module encapsulates the results for a |
27 | single test suite run. |
28 | |
29 | =head1 SYNOPSIS |
30 | |
31 | # Re-run failed tests |
32 | $ prove --state=fail,save -rbv |
33 | |
34 | =cut |
35 | |
36 | =head1 METHODS |
37 | |
38 | =head2 Class Methods |
39 | |
40 | =head3 C<new> |
41 | |
42 | my $result = App::Prove::State::Result->new({ |
43 | generation => $generation, |
44 | tests => \%tests, |
45 | }); |
46 | |
47 | Returns a new C<App::Prove::State::Result> instance. |
48 | |
49 | =cut |
50 | |
51 | sub new { |
52 | my ( $class, $arg_for ) = @_; |
53 | $arg_for ||= {}; |
54 | my %instance_data = %$arg_for; # shallow copy |
55 | $instance_data{version} = $class->state_version; |
56 | my $tests = delete $instance_data{tests} || {}; |
57 | my $self = bless \%instance_data => $class; |
58 | $self->_initialize($tests); |
59 | return $self; |
60 | } |
61 | |
62 | sub _initialize { |
63 | my ( $self, $tests ) = @_; |
64 | my %tests; |
65 | while ( my ( $name, $test ) = each %$tests ) { |
bdaf8c65 |
66 | $tests{$name} = $self->test_class->new( |
67 | { %$test, |
68 | name => $name |
69 | } |
70 | ); |
27fc0087 |
71 | } |
72 | $self->tests( \%tests ); |
73 | return $self; |
74 | } |
75 | |
76 | =head2 C<state_version> |
77 | |
78 | Returns the current version of state storage. |
79 | |
80 | =cut |
81 | |
82 | sub state_version {STATE_VERSION} |
83 | |
84 | =head2 C<test_class> |
85 | |
86 | Returns the name of the class used for tracking individual tests. This class |
87 | should either subclass from C<App::Prove::State::Result::Test> or provide an |
88 | identical interface. |
89 | |
90 | =cut |
91 | |
92 | sub test_class { |
93 | return 'App::Prove::State::Result::Test'; |
94 | } |
95 | |
96 | my %methods = ( |
97 | generation => { method => 'generation', default => 0 }, |
98 | last_run_time => { method => 'last_run_time', default => undef }, |
99 | ); |
100 | |
101 | while ( my ( $key, $description ) = each %methods ) { |
102 | my $default = $description->{default}; |
103 | no strict 'refs'; |
104 | *{ $description->{method} } = sub { |
105 | my $self = shift; |
106 | if (@_) { |
107 | $self->{$key} = shift; |
108 | return $self; |
109 | } |
110 | return $self->{$key} || $default; |
111 | }; |
112 | } |
113 | |
114 | =head3 C<generation> |
115 | |
116 | Getter/setter for the "generation" of the test suite run. The first |
117 | generation is 1 (one) and subsequent generations are 2, 3, etc. |
118 | |
119 | =head3 C<last_run_time> |
120 | |
121 | Getter/setter for the time of the test suite run. |
122 | |
123 | =head3 C<tests> |
124 | |
125 | Returns the tests for a given generation. This is a hashref or a hash, |
126 | depending on context called. The keys to the hash are the individual |
127 | test names and the value is a hashref with various interesting values. |
128 | Each k/v pair might resemble something like this: |
129 | |
130 | 't/foo.t' => { |
131 | elapsed => '0.0428488254547119', |
132 | gen => '7', |
133 | last_pass_time => '1219328376.07815', |
134 | last_result => '0', |
135 | last_run_time => '1219328376.07815', |
136 | last_todo => '0', |
137 | mtime => '1191708862', |
138 | seq => '192', |
139 | total_passes => '6', |
140 | } |
141 | |
142 | =cut |
143 | |
144 | sub tests { |
145 | my $self = shift; |
146 | if (@_) { |
147 | $self->{tests} = shift; |
148 | return $self; |
149 | } |
150 | my %tests = %{ $self->{tests} }; |
151 | my @tests = sort { $a->sequence <=> $b->sequence } values %tests; |
152 | return wantarray ? @tests : \@tests; |
153 | } |
154 | |
155 | =head3 C<test> |
156 | |
157 | my $test = $result->test('t/customer/create.t'); |
158 | |
159 | Returns an individual C<App::Prove::State::Result::Test> instance for the |
160 | given test name (usually the filename). Will return a new |
161 | C<App::Prove::State::Result::Test> instance if the name is not found. |
162 | |
163 | =cut |
164 | |
165 | sub test { |
166 | my ( $self, $name ) = @_; |
167 | croak("test() requires a test name") unless defined $name; |
168 | |
169 | my $tests = $self->{tests} ||= {}; |
170 | if ( my $test = $tests->{$name} ) { |
171 | return $test; |
172 | } |
173 | else { |
bdaf8c65 |
174 | my $test = $self->test_class->new( { name => $name } ); |
27fc0087 |
175 | $self->{tests}->{$name} = $test; |
176 | return $test; |
177 | } |
178 | } |
179 | |
180 | =head3 C<test_names> |
181 | |
182 | Returns an list of test names, sorted by run order. |
183 | |
184 | =cut |
185 | |
186 | sub test_names { |
187 | my $self = shift; |
188 | return map { $_->name } $self->tests; |
189 | } |
190 | |
191 | =head3 C<remove> |
192 | |
193 | $result->remove($test_name); # remove the test |
194 | my $test = $result->test($test_name); # fatal error |
195 | |
196 | Removes a given test from results. This is a no-op if the test name is not |
197 | found. |
198 | |
199 | =cut |
200 | |
201 | sub remove { |
202 | my ( $self, $name ) = @_; |
203 | delete $self->{tests}->{$name}; |
204 | return $self; |
205 | } |
206 | |
207 | =head3 C<num_tests> |
208 | |
209 | Returns the number of tests for a given test suite result. |
210 | |
211 | =cut |
212 | |
213 | sub num_tests { keys %{ shift->{tests} } } |
214 | |
215 | =head3 C<raw> |
216 | |
217 | Returns a hashref of raw results, suitable for serialization by YAML. |
218 | |
219 | =cut |
220 | |
221 | sub raw { |
222 | my $self = shift; |
223 | my %raw = %$self; |
224 | |
225 | my %tests; |
226 | foreach my $test ( $self->tests ) { |
227 | $tests{ $test->name } = $test->raw; |
228 | } |
229 | $raw{tests} = \%tests; |
230 | return \%raw; |
231 | } |
232 | |
233 | 1; |