Current Path : /usr/opt/perl530/lib/5.30.2/App/Prove/State/ |
FreeBSD hs32.drive.ne.jp 9.1-RELEASE FreeBSD 9.1-RELEASE #1: Wed Jan 14 12:18:08 JST 2015 root@hs32.drive.ne.jp:/sys/amd64/compile/hs32 amd64 |
Current File : //usr/opt/perl530/lib/5.30.2/App/Prove/State/Result.pm |
package App::Prove::State::Result; use strict; use warnings; use Carp 'croak'; use App::Prove::State::Result::Test; use constant STATE_VERSION => 1; =head1 NAME App::Prove::State::Result - Individual test suite results. =head1 VERSION Version 3.42 =cut our $VERSION = '3.42'; =head1 DESCRIPTION The C<prove> command supports a C<--state> option that instructs it to store persistent state across runs. This module encapsulates the results for a single test suite run. =head1 SYNOPSIS # Re-run failed tests $ prove --state=failed,save -rbv =cut =head1 METHODS =head2 Class Methods =head3 C<new> my $result = App::Prove::State::Result->new({ generation => $generation, tests => \%tests, }); Returns a new C<App::Prove::State::Result> instance. =cut sub new { my ( $class, $arg_for ) = @_; $arg_for ||= {}; my %instance_data = %$arg_for; # shallow copy $instance_data{version} = $class->state_version; my $tests = delete $instance_data{tests} || {}; my $self = bless \%instance_data => $class; $self->_initialize($tests); return $self; } sub _initialize { my ( $self, $tests ) = @_; my %tests; while ( my ( $name, $test ) = each %$tests ) { $tests{$name} = $self->test_class->new( { %$test, name => $name } ); } $self->tests( \%tests ); return $self; } =head2 C<state_version> Returns the current version of state storage. =cut sub state_version {STATE_VERSION} =head2 C<test_class> Returns the name of the class used for tracking individual tests. This class should either subclass from C<App::Prove::State::Result::Test> or provide an identical interface. =cut sub test_class { return 'App::Prove::State::Result::Test'; } my %methods = ( generation => { method => 'generation', default => 0 }, last_run_time => { method => 'last_run_time', default => undef }, ); while ( my ( $key, $description ) = each %methods ) { my $default = $description->{default}; no strict 'refs'; *{ $description->{method} } = sub { my $self = shift; if (@_) { $self->{$key} = shift; return $self; } return $self->{$key} || $default; }; } =head3 C<generation> Getter/setter for the "generation" of the test suite run. The first generation is 1 (one) and subsequent generations are 2, 3, etc. =head3 C<last_run_time> Getter/setter for the time of the test suite run. =head3 C<tests> Returns the tests for a given generation. This is a hashref or a hash, depending on context called. The keys to the hash are the individual test names and the value is a hashref with various interesting values. Each k/v pair might resemble something like this: 't/foo.t' => { elapsed => '0.0428488254547119', gen => '7', last_pass_time => '1219328376.07815', last_result => '0', last_run_time => '1219328376.07815', last_todo => '0', mtime => '1191708862', seq => '192', total_passes => '6', } =cut sub tests { my $self = shift; if (@_) { $self->{tests} = shift; return $self; } my %tests = %{ $self->{tests} }; my @tests = sort { $a->sequence <=> $b->sequence } values %tests; return wantarray ? @tests : \@tests; } =head3 C<test> my $test = $result->test('t/customer/create.t'); Returns an individual C<App::Prove::State::Result::Test> instance for the given test name (usually the filename). Will return a new C<App::Prove::State::Result::Test> instance if the name is not found. =cut sub test { my ( $self, $name ) = @_; croak("test() requires a test name") unless defined $name; my $tests = $self->{tests} ||= {}; if ( my $test = $tests->{$name} ) { return $test; } else { my $test = $self->test_class->new( { name => $name } ); $self->{tests}->{$name} = $test; return $test; } } =head3 C<test_names> Returns an list of test names, sorted by run order. =cut sub test_names { my $self = shift; return map { $_->name } $self->tests; } =head3 C<remove> $result->remove($test_name); # remove the test my $test = $result->test($test_name); # fatal error Removes a given test from results. This is a no-op if the test name is not found. =cut sub remove { my ( $self, $name ) = @_; delete $self->{tests}->{$name}; return $self; } =head3 C<num_tests> Returns the number of tests for a given test suite result. =cut sub num_tests { keys %{ shift->{tests} } } =head3 C<raw> Returns a hashref of raw results, suitable for serialization by YAML. =cut sub raw { my $self = shift; my %raw = %$self; my %tests; for my $test ( $self->tests ) { $tests{ $test->name } = $test->raw; } $raw{tests} = \%tests; return \%raw; } 1;