Commit | Line | Data |
---|---|---|
27fc0087 NC |
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 | ||
bdaf8c65 | 17 | Version 3.16 |
27fc0087 NC |
18 | |
19 | =cut | |
20 | ||
bdaf8c65 | 21 | $VERSION = '3.16'; |
27fc0087 NC |
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 SH |
66 | $tests{$name} = $self->test_class->new( |
67 | { %$test, | |
68 | name => $name | |
69 | } | |
70 | ); | |
27fc0087 NC |
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 NC |
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; |