This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Missing files from Test::Harness 3.05
authorNicholas Clark <nick@ccl4.org>
Wed, 19 Dec 2007 18:26:03 +0000 (18:26 +0000)
committerNicholas Clark <nick@ccl4.org>
Wed, 19 Dec 2007 18:26:03 +0000 (18:26 +0000)
p4raw-id: //depot/perl@32660

lib/App/Prove.pm [new file with mode: 0644]
lib/App/Prove/State.pm [new file with mode: 0644]

diff --git a/lib/App/Prove.pm b/lib/App/Prove.pm
new file mode 100644 (file)
index 0000000..592f92b
--- /dev/null
@@ -0,0 +1,603 @@
+package App::Prove;
+
+use strict;
+use TAP::Harness;
+use File::Spec;
+use Getopt::Long;
+use App::Prove::State;
+use Carp;
+
+use vars qw($VERSION);
+
+=head1 NAME
+
+App::Prove - Implements the C<prove> command.
+
+=head1 VERSION
+
+Version 3.05
+
+=cut
+
+$VERSION = '3.05';
+
+=head1 DESCRIPTION
+
+L<Test::Harness> provides a command, C<prove>, which runs a TAP based
+test suite and prints a report. The C<prove> command is a minimal
+wrapper around an instance of this module.
+
+=head1 SYNOPSIS
+
+    use App::Prove;
+
+    my $app = App::Prove->new;
+    $app->process_args(@ARGV);
+    $app->run;
+
+=cut
+
+use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
+use constant IS_VMS => $^O eq 'VMS';
+use constant IS_UNIXY => !( IS_VMS || IS_WIN32 );
+
+use constant STATE_FILE => IS_UNIXY ? '.prove'   : '_prove';
+use constant RC_FILE    => IS_UNIXY ? '.proverc' : '_proverc';
+
+use constant PLUGINS => 'App::Prove::Plugin';
+
+my @ATTR;
+
+BEGIN {
+    @ATTR = qw(
+      archive argv blib color directives exec failures fork formatter
+      harness includes modules plugins jobs lib merge parse quiet
+      really_quiet recurse backwards shuffle taint_fail taint_warn timer
+      verbose warnings_fail warnings_warn show_help show_man
+      show_version test_args state
+    );
+    for my $attr (@ATTR) {
+        no strict 'refs';
+        *$attr = sub {
+            my $self = shift;
+            croak "$attr is read-only" if @_;
+            $self->{$attr};
+        };
+    }
+}
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+Create a new C<App::Prove>. Optionally a hash ref of attribute
+initializers may be passed.
+
+=cut
+
+sub new {
+    my $class = shift;
+    my $args = shift || {};
+
+    my $self = bless {
+        argv          => [],
+        rc_opts       => [],
+        includes      => [],
+        modules       => [],
+        state         => [],
+        plugins       => [],
+        harness_class => 'TAP::Harness',
+        _state        => App::Prove::State->new( { store => STATE_FILE } ),
+    }, $class;
+
+    for my $attr (@ATTR) {
+        if ( exists $args->{$attr} ) {
+
+            # TODO: Some validation here
+            $self->{$attr} = $args->{$attr};
+        }
+    }
+    return $self;
+}
+
+=head3 C<add_rc_file>
+
+    $prove->add_rc_file('myproj/.proverc');
+
+Called before C<process_args> to prepend the contents of an rc file to
+the options.
+
+=cut
+
+sub add_rc_file {
+    my ( $self, $rc_file ) = @_;
+
+    local *RC;
+    open RC, "<$rc_file" or croak "Can't read $rc_file ($!)";
+    while ( defined( my $line = <RC> ) ) {
+        push @{ $self->{rc_opts} }, grep $_ && $_ !~ /^#/,
+          $line =~ m{ ' ([^']*) ' | " ([^"]*) " | (\#.*) | (\S*) }xg;
+    }
+    close RC;
+}
+
+=head3 C<process_args>
+
+    $prove->process_args(@args);
+
+Processes the command-line arguments. Attributes will be set
+appropriately. Any filenames may be found in the C<argv> attribute.
+
+Dies on invalid arguments.
+
+=cut
+
+sub process_args {
+    my $self = shift;
+
+    my @rc = RC_FILE;
+    unshift @rc, glob '~/' . RC_FILE if IS_UNIXY;
+
+    # Preprocess meta-args.
+    my @args;
+    while ( defined( my $arg = shift ) ) {
+        if ( $arg eq '--norc' ) {
+            @rc = ();
+        }
+        elsif ( $arg eq '--rc' ) {
+            defined( my $rc = shift )
+              or croak "Missing argument to --rc";
+            push @rc, $rc;
+        }
+        elsif ( $arg =~ m{^--rc=(.+)$} ) {
+            push @rc, $1;
+        }
+        else {
+            push @args, $arg;
+        }
+    }
+
+    # Everything after the arisdottle '::' gets passed as args to
+    # test programs.
+    if ( defined( my $stop_at = _first_pos( '::', @args ) ) ) {
+        my @test_args = splice @args, $stop_at;
+        shift @test_args;
+        $self->{test_args} = \@test_args;
+    }
+
+    # Grab options from RC files
+    $self->add_rc_file($_) for grep -f, @rc;
+    unshift @args, @{ $self->{rc_opts} };
+
+    if ( my @bad = map {"-$_"} grep {/^-(man|help)$/} @args ) {
+        die "Long options should be written with two dashes: ",
+          join( ', ', @bad ), "\n";
+    }
+
+    # And finally...
+
+    {
+        local @ARGV = @args;
+        Getopt::Long::Configure( 'no_ignore_case', 'bundling' );
+
+        # Don't add coderefs to GetOptions
+        GetOptions(
+            'v|verbose'   => \$self->{verbose},
+            'f|failures'  => \$self->{failures},
+            'l|lib'       => \$self->{lib},
+            'b|blib'      => \$self->{blib},
+            's|shuffle'   => \$self->{shuffle},
+            'color!'      => \$self->{color},
+            'c'           => \$self->{color},
+            'harness=s'   => \$self->{harness},
+            'formatter=s' => \$self->{formatter},
+            'r|recurse'   => \$self->{recurse},
+            'reverse'     => \$self->{backwards},
+            'fork'        => \$self->{fork},
+            'p|parse'     => \$self->{parse},
+            'q|quiet'     => \$self->{quiet},
+            'Q|QUIET'     => \$self->{really_quiet},
+            'e|exec=s'    => \$self->{exec},
+            'm|merge'     => \$self->{merge},
+            'I=s@'        => $self->{includes},
+            'M=s@'        => $self->{modules},
+            'P=s@'        => $self->{plugins},
+            'state=s@'    => $self->{state},
+            'directives'  => \$self->{directives},
+            'h|help|?'    => \$self->{show_help},
+            'H|man'       => \$self->{show_man},
+            'V|version'   => \$self->{show_version},
+            'a|archive=s' => \$self->{archive},
+            'j|jobs=i'    => \$self->{jobs},
+            'timer'       => \$self->{timer},
+            'T'           => \$self->{taint_fail},
+            't'           => \$self->{taint_warn},
+            'W'           => \$self->{warnings_fail},
+            'w'           => \$self->{warnings_warn},
+        ) or croak('Unable to continue');
+
+        # Stash the remainder of argv for later
+        $self->{argv} = [@ARGV];
+    }
+
+    return;
+}
+
+sub _first_pos {
+    my $want = shift;
+    for ( 0 .. $#_ ) {
+        return $_ if $_[$_] eq $want;
+    }
+    return;
+}
+
+sub _exit { exit( $_[1] || 0 ) }
+
+sub _help {
+    my ( $self, $verbosity ) = @_;
+
+    eval('use Pod::Usage 1.12 ()');
+    if ( my $err = $@ ) {
+        die 'Please install Pod::Usage for the --help option '
+          . '(or try `perldoc prove`.)'
+          . "\n ($@)";
+    }
+
+    Pod::Usage::pod2usage( { -verbose => $verbosity } );
+
+    return;
+}
+
+sub _color_default {
+    my $self = shift;
+
+    return -t STDOUT && !IS_WIN32;
+}
+
+sub _get_args {
+    my $self = shift;
+
+    my %args;
+
+    if ( defined $self->color ? $self->color : $self->_color_default ) {
+        $args{color} = 1;
+    }
+
+    if ( $self->archive ) {
+        $self->require_harness( archive => 'TAP::Harness::Archive' );
+        $args{archive} = $self->archive;
+    }
+
+    if ( my $jobs = $self->jobs ) {
+        $args{jobs} = $jobs;
+    }
+
+    if ( my $fork = $self->fork ) {
+        $args{fork} = $fork;
+    }
+
+    if ( my $harness_opt = $self->harness ) {
+        $self->require_harness( harness => $harness_opt );
+    }
+
+    if ( my $formatter = $self->formatter ) {
+        $args{formatter_class} = $formatter;
+    }
+
+    if ( $self->taint_fail && $self->taint_warn ) {
+        die '-t and -T are mutually exclusive';
+    }
+
+    if ( $self->warnings_fail && $self->warnings_warn ) {
+        die '-w and -W are mutually exclusive';
+    }
+
+    for my $a (qw( lib switches )) {
+        my $method = "_get_$a";
+        my $val    = $self->$method();
+        $args{$a} = $val if defined $val;
+    }
+
+    # Handle verbose, quiet, really_quiet flags
+    my %verb_map = ( verbose => 1, quiet => -1, really_quiet => -2, );
+
+    my @verb_adj = grep {$_} map { $self->$_() ? $verb_map{$_} : 0 }
+      keys %verb_map;
+
+    die "Only one of verbose, quiet or really_quiet should be specified\n"
+      if @verb_adj > 1;
+
+    $args{verbosity} = shift @verb_adj || 0;
+
+    for my $a (qw( merge failures timer directives )) {
+        $args{$a} = 1 if $self->$a();
+    }
+
+    $args{errors} = 1 if $self->parse;
+
+    # defined but zero-length exec runs test files as binaries
+    $args{exec} = [ split( /\s+/, $self->exec ) ]
+      if ( defined( $self->exec ) );
+
+    if ( defined( my $test_args = $self->test_args ) ) {
+        $args{test_args} = $test_args;
+    }
+
+    return ( \%args, $self->{harness_class} );
+}
+
+sub _find_module {
+    my ( $self, $class, @search ) = @_;
+
+    croak "Bad module name $class"
+      unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
+
+    for my $pfx (@search) {
+        my $name = join( '::', $pfx, $class );
+        print "$name\n";
+        eval "require $name";
+        return $name unless $@;
+    }
+
+    eval "require $class";
+    return $class unless $@;
+    return;
+}
+
+sub _load_extension {
+    my ( $self, $class, @search ) = @_;
+
+    my @args = ();
+    if ( $class =~ /^(.*?)=(.*)/ ) {
+        $class = $1;
+        @args = split( /,/, $2 );
+    }
+
+    if ( my $name = $self->_find_module( $class, @search ) ) {
+        $name->import(@args);
+    }
+    else {
+        croak "Can't load module $class";
+    }
+}
+
+sub _load_extensions {
+    my ( $self, $ext, @search ) = @_;
+    $self->_load_extension( $_, @search ) for @$ext;
+}
+
+=head3 C<run>
+
+Perform whatever actions the command line args specified. The C<prove>
+command line tool consists of the following code:
+
+    use App::Prove;
+
+    my $app = App::Prove->new;
+    $app->process_args(@ARGV);
+    $app->run;
+
+=cut
+
+sub run {
+    my $self = shift;
+
+    if ( $self->show_help ) {
+        $self->_help(1);
+    }
+    elsif ( $self->show_man ) {
+        $self->_help(2);
+    }
+    elsif ( $self->show_version ) {
+        $self->print_version;
+    }
+    else {
+
+        $self->_load_extensions( $self->modules );
+        $self->_load_extensions( $self->plugins, PLUGINS );
+
+        my $state = $self->{_state};
+        if ( defined( my $state_switch = $self->state ) ) {
+            $state->apply_switch(@$state_switch);
+        }
+
+        my @tests = $state->get_tests( $self->recurse, @{ $self->argv } );
+
+        $self->_shuffle(@tests) if $self->shuffle;
+        @tests = reverse @tests if $self->backwards;
+
+        $self->_runtests( $self->_get_args, @tests );
+    }
+
+    return;
+}
+
+sub _runtests {
+    my ( $self, $args, $harness_class, @tests ) = @_;
+    my $harness = $harness_class->new($args);
+
+    $harness->callback(
+        after_test => sub {
+            $self->{_state}->observe_test(@_);
+        }
+    );
+
+    my $aggregator = $harness->runtests(@tests);
+
+    $self->_exit( $aggregator->has_problems ? 1 : 0 );
+
+    return;
+}
+
+sub _get_switches {
+    my $self = shift;
+    my @switches;
+
+    # notes that -T or -t must be at the front of the switches!
+    if ( $self->taint_fail ) {
+        push @switches, '-T';
+    }
+    elsif ( $self->taint_warn ) {
+        push @switches, '-t';
+    }
+    if ( $self->warnings_fail ) {
+        push @switches, '-W';
+    }
+    elsif ( $self->warnings_warn ) {
+        push @switches, '-w';
+    }
+
+    return @switches ? \@switches : ();
+}
+
+sub _get_lib {
+    my $self = shift;
+    my @libs;
+    if ( $self->lib ) {
+        push @libs, 'lib';
+    }
+    if ( $self->blib ) {
+        push @libs, 'blib/lib', 'blib/arch';
+    }
+    if ( @{ $self->includes } ) {
+        push @libs, @{ $self->includes };
+    }
+
+    #24926
+    @libs = map { File::Spec->rel2abs($_) } @libs;
+
+    # Huh?
+    return @libs ? \@libs : ();
+}
+
+sub _shuffle {
+    my $self = shift;
+
+    # Fisher-Yates shuffle
+    my $i = @_;
+    while ($i) {
+        my $j = rand $i--;
+        @_[ $i, $j ] = @_[ $j, $i ];
+    }
+    return;
+}
+
+=head3 C<require_harness>
+
+Load a harness replacement class.
+
+  $prove->require_harness($for => $class_name);
+
+=cut
+
+sub require_harness {
+    my ( $self, $for, $class ) = @_;
+
+    eval("require $class");
+    die "$class is required to use the --$for feature: $@" if $@;
+
+    $self->{harness_class} = $class;
+
+    return;
+}
+
+=head3 C<print_version>
+
+Display the version numbers of the loaded L<TAP::Harness> and the
+current Perl.
+
+=cut
+
+sub print_version {
+    my $self = shift;
+    printf(
+        "TAP::Harness v%s and Perl v%vd\n",
+        $TAP::Harness::VERSION, $^V
+    );
+
+    return;
+}
+
+1;
+
+# vim:ts=4:sw=4:et:sta
+
+__END__
+
+=head2 Attributes
+
+After command line parsing the following attributes reflect the values
+of the corresponding command line switches. They may be altered before
+calling C<run>.
+
+=over
+
+=item C<archive>
+
+=item C<argv>
+
+=item C<backwards>
+
+=item C<blib>
+
+=item C<color>
+
+=item C<directives>
+
+=item C<exec>
+
+=item C<failures>
+
+=item C<fork>
+
+=item C<formatter>
+
+=item C<harness>
+
+=item C<includes>
+
+=item C<jobs>
+
+=item C<lib>
+
+=item C<merge>
+
+=item C<modules>
+
+=item C<parse>
+
+=item C<plugins>
+
+=item C<quiet>
+
+=item C<really_quiet>
+
+=item C<recurse>
+
+=item C<show_help>
+
+=item C<show_man>
+
+=item C<show_version>
+
+=item C<shuffle>
+
+=item C<state>
+
+=item C<taint_fail>
+
+=item C<taint_warn>
+
+=item C<test_args>
+
+=item C<timer>
+
+=item C<verbose>
+
+=item C<warnings_fail>
+
+=item C<warnings_warn>
+
+=back
diff --git a/lib/App/Prove/State.pm b/lib/App/Prove/State.pm
new file mode 100644 (file)
index 0000000..fc4f035
--- /dev/null
@@ -0,0 +1,417 @@
+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.05
+
+=cut
+
+$VERSION = '3.05';
+
+=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 {
+                        ( $_->{total_failures} || 0 )
+                      + ( $_->{total_passes} || 0 );
+                }
+            );
+        },
+        old => sub {
+            $self->_select(
+                order => sub {
+                    -(    ( $_->{total_failures} || 0 )
+                        + ( $_->{total_passes} || 0 ) );
+                }
+            );
+        },
+        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 ) {
+        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->{_}->{generation}++;
+}
+
+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};
+    }
+}