summaryrefslogtreecommitdiffstats
path: root/chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm
diff options
context:
space:
mode:
Diffstat (limited to 'chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm')
-rw-r--r--chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm421
1 files changed, 0 insertions, 421 deletions
diff --git a/chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm b/chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm
deleted file mode 100644
index dbc73f41cc3..00000000000
--- a/chromium/third_party/cygwin/lib/perl5/5.10/App/Prove/State.pm
+++ /dev/null
@@ -1,421 +0,0 @@
-package App::Prove::State;
-
-use strict;
-use File::Find;
-use File::Spec;
-use Carp;
-use TAP::Parser::YAMLish::Reader ();
-use TAP::Parser::YAMLish::Writer ();
-use TAP::Base;
-
-use vars qw($VERSION @ISA);
-@ISA = qw( TAP::Base );
-
-use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
-use constant NEED_GLOB => IS_WIN32;
-
-=head1 NAME
-
-App::Prove::State - State storage for the C<prove> command.
-
-=head1 VERSION
-
-Version 3.10
-
-=cut
-
-$VERSION = '3.10';
-
-=head1 DESCRIPTION
-
-The C<prove> command supports a C<--state> option that instructs it to
-store persistent state across runs. This module implements that state
-and the operations that may be performed on it.
-
-=head1 SYNOPSIS
-
- # Re-run failed tests
- $ prove --state=fail,save -rbv
-
-=cut
-
-=head1 METHODS
-
-=head2 Class Methods
-
-=head3 C<new>
-
-=cut
-
-sub new {
- my $class = shift;
- my %args = %{ shift || {} };
-
- my $self = bless {
- _ => {
- tests => {},
- generation => 1
- },
- select => [],
- seq => 1,
- store => delete $args{store},
- }, $class;
-
- my $store = $self->{store};
- $self->load($store)
- if defined $store && -f $store;
-
- return $self;
-}
-
-sub DESTROY {
- my $self = shift;
- if ( $self->{should_save} && defined( my $store = $self->{store} ) ) {
- $self->save($store);
- }
-}
-
-=head2 Instance Methods
-
-=head3 C<apply_switch>
-
-Apply a list of switch options to the state.
-
-=over
-
-=item C<last>
-
-Run in the same order as last time
-
-=item C<failed>
-
-Run only the failed tests from last time
-
-=item C<passed>
-
-Run only the passed tests from last time
-
-=item C<all>
-
-Run all tests in normal order
-
-=item C<hot>
-
-Run the tests that most recently failed first
-
-=item C<todo>
-
-Run the tests ordered by number of todos.
-
-=item C<slow>
-
-Run the tests in slowest to fastest order.
-
-=item C<fast>
-
-Run test tests in fastest to slowest order.
-
-=item C<new>
-
-Run the tests in newest to oldest order.
-
-=item C<old>
-
-Run the tests in oldest to newest order.
-
-=item C<save>
-
-Save the state on exit.
-
-=back
-
-=cut
-
-sub apply_switch {
- my $self = shift;
- my @opts = @_;
-
- my $last_gen = $self->{_}->{generation} - 1;
- my $now = $self->get_time;
-
- my @switches = map { split /,/ } @opts;
-
- my %handler = (
- last => sub {
- $self->_select(
- where => sub { $_->{gen} >= $last_gen },
- order => sub { $_->{seq} }
- );
- },
- failed => sub {
- $self->_select(
- where => sub { $_->{last_result} != 0 },
- order => sub { -$_->{last_result} }
- );
- },
- passed => sub {
- $self->_select( where => sub { $_->{last_result} == 0 } );
- },
- all => sub {
- $self->_select();
- },
- todo => sub {
- $self->_select(
- where => sub { $_->{last_todo} != 0 },
- order => sub { -$_->{last_todo}; }
- );
- },
- hot => sub {
- $self->_select(
- where => sub { defined $_->{last_fail_time} },
- order => sub { $now - $_->{last_fail_time} }
- );
- },
- slow => sub {
- $self->_select( order => sub { -$_->{elapsed} } );
- },
- fast => sub {
- $self->_select( order => sub { $_->{elapsed} } );
- },
- new => sub {
- $self->_select( order => sub { -$_->{mtime} } );
- },
- old => sub {
- $self->_select( order => sub { $_->{mtime} } );
- },
- save => sub {
- $self->{should_save}++;
- },
- adrian => sub {
- unshift @switches, qw( hot all save );
- },
- );
-
- while ( defined( my $ele = shift @switches ) ) {
- my ( $opt, $arg )
- = ( $ele =~ /^([^:]+):(.*)/ )
- ? ( $1, $2 )
- : ( $ele, undef );
- my $code = $handler{$opt}
- || croak "Illegal state option: $opt";
- $code->($arg);
- }
-}
-
-sub _select {
- my ( $self, %spec ) = @_;
- push @{ $self->{select} }, \%spec;
-}
-
-=head3 C<get_tests>
-
-Given a list of args get the names of tests that should run
-
-=cut
-
-sub get_tests {
- my $self = shift;
- my $recurse = shift;
- my @argv = @_;
- my %seen;
-
- my @selected = $self->_query;
-
- unless ( @argv || @{ $self->{select} } ) {
- croak q{No tests named and 't' directory not found}
- unless -d 't';
- @argv = 't';
- }
-
- push @selected, $self->_get_raw_tests( $recurse, @argv ) if @argv;
- return grep { !$seen{$_}++ } @selected;
-}
-
-sub _query {
- my $self = shift;
- if ( my @sel = @{ $self->{select} } ) {
- warn "No saved state, selection will be empty\n"
- unless keys %{ $self->{_}->{tests} };
- return map { $self->_query_clause($_) } @sel;
- }
- return;
-}
-
-sub _query_clause {
- my ( $self, $clause ) = @_;
- my @got;
- my $tests = $self->{_}->{tests};
- my $where = $clause->{where} || sub {1};
-
- # Select
- for my $test ( sort keys %$tests ) {
- next unless -f $test;
- local $_ = $tests->{$test};
- push @got, $test if $where->();
- }
-
- # Sort
- if ( my $order = $clause->{order} ) {
- @got = map { $_->[0] }
- sort {
- ( defined $b->[1] <=> defined $a->[1] )
- || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) )
- } map {
- [ $_,
- do { local $_ = $tests->{$_}; $order->() }
- ]
- } @got;
- }
-
- return @got;
-}
-
-sub _get_raw_tests {
- my $self = shift;
- my $recurse = shift;
- my @argv = @_;
- my @tests;
-
- # Do globbing on Win32.
- @argv = map { glob "$_" } @argv if NEED_GLOB;
-
- for my $arg (@argv) {
- if ( '-' eq $arg ) {
- push @argv => <STDIN>;
- chomp(@argv);
- next;
- }
-
- push @tests,
- sort -d $arg
- ? $recurse
- ? $self->_expand_dir_recursive($arg)
- : glob( File::Spec->catfile( $arg, '*.t' ) )
- : $arg;
- }
- return @tests;
-}
-
-sub _expand_dir_recursive {
- my ( $self, $dir ) = @_;
-
- my @tests;
- find(
- { follow => 1, #21938
- wanted => sub {
- -f
- && /\.t$/
- && push @tests => $File::Find::name;
- }
- },
- $dir
- );
- return @tests;
-}
-
-=head3 C<observe_test>
-
-Store the results of a test.
-
-=cut
-
-sub observe_test {
- my ( $self, $test, $parser ) = @_;
- $self->_record_test(
- $test, scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 ),
- scalar( $parser->todo ), $parser->start_time, $parser->end_time
- );
-}
-
-# Store:
-# last fail time
-# last pass time
-# last run time
-# most recent result
-# most recent todos
-# total failures
-# total passes
-# state generation
-
-sub _record_test {
- my ( $self, $test, $fail, $todo, $start_time, $end_time ) = @_;
- my $rec = $self->{_}->{tests}->{ $test->[0] } ||= {};
-
- $rec->{seq} = $self->{seq}++;
- $rec->{gen} = $self->{_}->{generation};
-
- $rec->{last_run_time} = $end_time;
- $rec->{last_result} = $fail;
- $rec->{last_todo} = $todo;
- $rec->{elapsed} = $end_time - $start_time;
-
- if ($fail) {
- $rec->{total_failures}++;
- $rec->{last_fail_time} = $end_time;
- }
- else {
- $rec->{total_passes}++;
- $rec->{last_pass_time} = $end_time;
- }
-}
-
-=head3 C<save>
-
-Write the state to a file.
-
-=cut
-
-sub save {
- my ( $self, $name ) = @_;
- my $writer = TAP::Parser::YAMLish::Writer->new;
- local *FH;
- open FH, ">$name" or croak "Can't write $name ($!)";
- $writer->write( $self->{_} || {}, \*FH );
- close FH;
-}
-
-=head3 C<load>
-
-Load the state from a file
-
-=cut
-
-sub load {
- my ( $self, $name ) = @_;
- my $reader = TAP::Parser::YAMLish::Reader->new;
- local *FH;
- open FH, "<$name" or croak "Can't read $name ($!)";
- $self->{_} = $reader->read(
- sub {
- my $line = <FH>;
- defined $line && chomp $line;
- return $line;
- }
- );
-
- # $writer->write( $self->{tests} || {}, \*FH );
- close FH;
- $self->_regen_seq;
- $self->_prune_and_stamp;
- $self->{_}->{generation}++;
-}
-
-sub _prune_and_stamp {
- my $self = shift;
- for my $name ( keys %{ $self->{_}->{tests} || {} } ) {
- if ( my @stat = stat $name ) {
- $self->{_}->{tests}->{$name}->{mtime} = $stat[9];
- }
- else {
- delete $self->{_}->{tests}->{$name};
- }
- }
-}
-
-sub _regen_seq {
- my $self = shift;
- for my $rec ( values %{ $self->{_}->{tests} || {} } ) {
- $self->{seq} = $rec->{seq} + 1
- if defined $rec->{seq} && $rec->{seq} >= $self->{seq};
- }
-}
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-07 16:37:13 +0000