Update Test-Harness to CPAN version 3.39
[perl.git] / cpan / Test-Harness / lib / App / Prove / State / Result.pm
1 package App::Prove::State::Result;
2
3 use strict;
4 use warnings;
5 use Carp 'croak';
6
7 use App::Prove::State::Result::Test;
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
17 Version 3.39
18
19 =cut
20
21 our $VERSION = '3.39';
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=failed,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 ) {
66         $tests{$name} = $self->test_class->new(
67             {   %$test,
68                 name => $name
69             }
70         );
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 {
174         my $test = $self->test_class->new( { name => $name } );
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     for my $test ( $self->tests ) {
227         $tests{ $test->name } = $test->raw;
228     }
229     $raw{tests} = \%tests;
230     return \%raw;
231 }
232
233 1;