This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Test::Harness 3.14
authorNicholas Clark <nick@ccl4.org>
Sat, 13 Sep 2008 15:25:35 +0000 (15:25 +0000)
committerNicholas Clark <nick@ccl4.org>
Sat, 13 Sep 2008 15:25:35 +0000 (15:25 +0000)
p4raw-id: //depot/perl@34359

66 files changed:
MANIFEST
ext/Test/Harness/Changes
ext/Test/Harness/Makefile.PL
ext/Test/Harness/bin/prove
ext/Test/Harness/lib/App/Prove.pm
ext/Test/Harness/lib/App/Prove/State.pm
ext/Test/Harness/lib/App/Prove/State/Result.pm [new file with mode: 0644]
ext/Test/Harness/lib/App/Prove/State/Result/Test.pm [new file with mode: 0644]
ext/Test/Harness/lib/TAP/Base.pm
ext/Test/Harness/lib/TAP/Formatter/Color.pm
ext/Test/Harness/lib/TAP/Formatter/Console.pm
ext/Test/Harness/lib/TAP/Formatter/Console/ParallelSession.pm
ext/Test/Harness/lib/TAP/Formatter/Console/Session.pm
ext/Test/Harness/lib/TAP/Harness.pm
ext/Test/Harness/lib/TAP/Object.pm
ext/Test/Harness/lib/TAP/Parser.pm
ext/Test/Harness/lib/TAP/Parser/Aggregator.pm
ext/Test/Harness/lib/TAP/Parser/Grammar.pm
ext/Test/Harness/lib/TAP/Parser/Iterator.pm
ext/Test/Harness/lib/TAP/Parser/Iterator/Array.pm
ext/Test/Harness/lib/TAP/Parser/Iterator/Process.pm
ext/Test/Harness/lib/TAP/Parser/Iterator/Stream.pm
ext/Test/Harness/lib/TAP/Parser/IteratorFactory.pm
ext/Test/Harness/lib/TAP/Parser/Multiplexer.pm
ext/Test/Harness/lib/TAP/Parser/Result.pm
ext/Test/Harness/lib/TAP/Parser/Result/Bailout.pm
ext/Test/Harness/lib/TAP/Parser/Result/Comment.pm
ext/Test/Harness/lib/TAP/Parser/Result/Plan.pm
ext/Test/Harness/lib/TAP/Parser/Result/Pragma.pm
ext/Test/Harness/lib/TAP/Parser/Result/Test.pm
ext/Test/Harness/lib/TAP/Parser/Result/Unknown.pm
ext/Test/Harness/lib/TAP/Parser/Result/Version.pm
ext/Test/Harness/lib/TAP/Parser/Result/YAML.pm
ext/Test/Harness/lib/TAP/Parser/ResultFactory.pm
ext/Test/Harness/lib/TAP/Parser/Scheduler.pm
ext/Test/Harness/lib/TAP/Parser/Scheduler/Job.pm
ext/Test/Harness/lib/TAP/Parser/Scheduler/Spinner.pm
ext/Test/Harness/lib/TAP/Parser/Source.pm
ext/Test/Harness/lib/TAP/Parser/Source/Perl.pm
ext/Test/Harness/lib/TAP/Parser/Utils.pm
ext/Test/Harness/lib/TAP/Parser/YAMLish/Reader.pm
ext/Test/Harness/lib/TAP/Parser/YAMLish/Writer.pm
ext/Test/Harness/lib/Test/Harness.pm
ext/Test/Harness/t/000-load.t
ext/Test/Harness/t/compat/failure.t
ext/Test/Harness/t/compat/test-harness-compat.t
ext/Test/Harness/t/glob-to-regexp.t [new file with mode: 0644]
ext/Test/Harness/t/harness-subclass.t [new file with mode: 0644]
ext/Test/Harness/t/harness.t
ext/Test/Harness/t/iterators.t
ext/Test/Harness/t/lib/NOP.pm [new file with mode: 0644]
ext/Test/Harness/t/multiplexer.t
ext/Test/Harness/t/nofork.t
ext/Test/Harness/t/parse.t
ext/Test/Harness/t/process.t
ext/Test/Harness/t/prove.t
ext/Test/Harness/t/proverc.t
ext/Test/Harness/t/proverun.t
ext/Test/Harness/t/regression.t
ext/Test/Harness/t/sample-tests/delayed
ext/Test/Harness/t/sample-tests/inc_taint
ext/Test/Harness/t/sample-tests/stdout_stderr
ext/Test/Harness/t/source.t
ext/Test/Harness/t/state.t
ext/Test/Harness/t/state_results.t [new file with mode: 0644]
ext/Test/Harness/t/testargs.t

index 2872eeb..7eaab54 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -1125,6 +1125,8 @@ ext/Test/Harness/bin/prove                The prove harness utility
 ext/Test/Harness/Changes               Test::Harness change log
 ext/Test/Harness/lib/App/Prove.pm      Gubbins for the prove utility
 ext/Test/Harness/lib/App/Prove/State.pm        Gubbins for the prove utility
+ext/Test/Harness/lib/App/Prove/State/Result.pm Gubbins for the prove utility
+ext/Test/Harness/lib/App/Prove/State/Result/Test.pm    Gubbins for the prove utility
 ext/Test/Harness/lib/TAP/Base.pm                       A parser for Test Anything Protocol
 ext/Test/Harness/lib/TAP/Formatter/Color.pm            A parser for Test Anything Protocol
 ext/Test/Harness/lib/TAP/Formatter/Console/ParallelSession.pm  A parser for Test Anything Protocol
@@ -1179,7 +1181,9 @@ ext/Test/Harness/t/data/catme.1                           Test data for Test::Harness
 ext/Test/Harness/t/data/proverc                                Test data for Test::Harness
 ext/Test/Harness/t/data/sample.yml                     Test data for Test::Harness
 ext/Test/Harness/t/errors.t                            Test::Harness test
+ext/Test/Harness/t/glob-to-regexp.t                    Test::Harness test
 ext/Test/Harness/t/grammar.t                           Test::Harness test
+ext/Test/Harness/t/harness-subclass.t                  Test::Harness test
 ext/Test/Harness/t/harness.t                           Test::Harness test
 ext/Test/Harness/t/iterators.t                         Test::Harness test
 ext/Test/Harness/t/lib/App/Prove/Plugin/Dummy.pm       Module for testing Test::Harness
@@ -1195,6 +1199,7 @@ ext/Test/Harness/t/lib/MyResultFactory.pm         Module for testing Test::Harness
 ext/Test/Harness/t/lib/MyResult.pm                     Module for testing Test::Harness
 ext/Test/Harness/t/lib/MySource.pm                     Module for testing Test::Harness
 ext/Test/Harness/t/lib/NoFork.pm                       Module for testing Test::Harness
+ext/Test/Harness/t/lib/NOP.pm                          Module for testing Test::Harness
 ext/Test/Harness/t/lib/TAP/Parser/SubclassTest.pm      Module for testing Test::Harness
 ext/Test/Harness/t/multiplexer.t                       Test::Harness test
 ext/Test/Harness/t/nofork-mux.t                                Test::Harness test
@@ -1274,6 +1279,7 @@ ext/Test/Harness/t/source_tests/harness_directives        Test data for Test::Harness
 ext/Test/Harness/t/source_tests/harness_failure                Test data for Test::Harness
 ext/Test/Harness/t/source_tests/source                 Test data for Test::Harness
 ext/Test/Harness/t/spool.t                             Test::Harness test
+ext/Test/Harness/t/state_results.t                     Test::Harness test
 ext/Test/Harness/t/state.t                             Test::Harness test
 ext/Test/Harness/t/streams.t                           Test::Harness test
 ext/Test/Harness/t/subclass_tests/non_perl_source      Test data for Test::Harness
index 2051eab..4ae9f1d 100644 (file)
@@ -1,5 +1,15 @@
 Revision history for Test-Harness
 
+
+3.14
+        - Created a proper (ha!) API for prove state results and tests.
+        - Added --count and --nocount options to prove to control X/Y display
+          while running tests.
+        - Added 'fresh' state option to run test scripts that have been
+          touched since the test run.
+        - fixed bug where PERL5OPT was not properly split  
+        - fixed regex in _filtered_inc. Fixes #39248. Thanks Slaven.
+
 3.13    2008-07-27
         - fixed various closure related leaks
         - made prove honour HARNESS_TIMER
index e6e34c3..6bc533c 100644 (file)
@@ -18,12 +18,12 @@ my %mm_args = (
     'INSTALLDIRS' => 'perl',
     'PL_FILES'    => {},
     'test'        => { 'TESTS' => 't/*.t t/compat/*.t' },
+
     # In the core pods will be built by installman, and prove found by
     # utils/prove.PL
-    $core ? (
-    'MAN3PODS'    => {}
-    ) : (
-    'EXE_FILES'   => ['bin/prove'],
+    $core
+    ? ( 'MAN3PODS' => {} )
+    : ( 'EXE_FILES' => ['bin/prove'],
     ),
 );
 
index ee31df8..01df160 100644 (file)
@@ -27,6 +27,8 @@ Boolean options:
  -s,  --shuffle     Run the tests in random order.
  -c,  --color       Colored test output (default).
       --nocolor     Do not color test output.
+      --count       Show the X/Y test count when not verbose (default)
+      --nocount     Disable the X/Y test count.
  -D   --dry         Dry run. Show test that would have run.
       --ext         Set the extension for tests (default '.t')
  -f,  --failures    Only show failed tests.
@@ -143,8 +145,7 @@ and can live with the risk.
 =head2 C<--state>
 
 You can ask C<prove> to remember the state of previous test runs and
-select and/or order the tests to be run this time based on that
-saved state.
+select and/or order the tests to be run based on that saved state.
 
 The C<--state> switch requires an argument which must be a comma
 separated list of one or more of the following options.
@@ -225,12 +226,17 @@ Run test tests in fastest to slowest order.
 
 =item C<new>
 
-Run the tests in newest to oldest order.
+Run the tests in newest to oldest order based on the modification times
+of the test scripts.
 
 =item C<old>
 
 Run the tests in oldest to newest order.
 
+=item C<fresh>
+
+Run those test scripts that have been modified since the last test run.
+
 =item C<save>
 
 Save the state on exit. The state is stored in a file called F<.prove>
index b68ca40..29d2f8f 100644 (file)
@@ -19,11 +19,11 @@ App::Prove - Implements the C<prove> command.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
@@ -54,18 +54,18 @@ my @ATTR;
 
 BEGIN {
     @ATTR = qw(
-      archive argv blib color directives exec failures fork formatter
-      harness includes modules plugins jobs lib merge parse quiet
+      archive argv blib show_count 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 dry extension ignore_exit rules
+      verbose warnings_fail warnings_warn show_help show_man show_version
+      test_args state dry extension ignore_exit rules state_manager
     );
     for my $attr (@ATTR) {
         no strict 'refs';
         *$attr = sub {
             my $self = shift;
-            croak "$attr is read-only" if @_;
-            $self->{$attr};
+            $self->{$attr} = shift if @_;
+            return $self->{$attr};
         };
     }
 }
@@ -92,7 +92,6 @@ sub _initialize {
         $self->{$key} = [];
     }
     $self->{harness_class} = 'TAP::Harness';
-    $self->{_state} = App::Prove::State->new( { store => STATE_FILE } );
 
     for my $attr (@ATTR) {
         if ( exists $args->{$attr} ) {
@@ -109,10 +108,27 @@ sub _initialize {
     while ( my ( $env, $attr ) = each %env_provides_default ) {
         $self->{$attr} = 1 if $ENV{$env};
     }
+    $self->state_manager(
+        $self->state_class->new( { store => STATE_FILE } ) );
 
     return $self;
 }
 
+=head3 C<state_class>
+
+Returns the name of the class used for maintaining state.  This class should
+either subclass from C<App::Prove::State> or provide an identical interface.
+
+=head3 C<state_manager>
+
+Getter/setter for the an instane of the C<state_class>.
+
+=cut
+
+sub state_class {
+    return 'App::Prove::State';
+}
+
 =head3 C<add_rc_file>
 
     $prove->add_rc_file('myproj/.proverc');
@@ -202,6 +218,7 @@ sub process_args {
             's|shuffle'   => \$self->{shuffle},
             'color!'      => \$self->{color},
             'colour!'     => \$self->{color},
+            'count!'      => \$self->{show_count},
             'c'           => \$self->{color},
             'D|dry'       => \$self->{dry},
             'ext=s'       => \$self->{extension},
@@ -278,6 +295,12 @@ sub _get_args {
     if ( defined $self->color ? $self->color : $self->_color_default ) {
         $args{color} = 1;
     }
+    if ( !defined $self->show_count ) {
+        $args{show_count} = 1;
+    }
+    else {
+        $args{show_count} = $self->show_count;
+    }
 
     if ( $self->archive ) {
         $self->require_harness( archive => 'TAP::Harness::Archive' );
@@ -367,7 +390,6 @@ sub _find_module {
 
     for my $pfx (@search) {
         my $name = join( '::', $pfx, $class );
-        print "$name\n";
         eval "require $name";
         return $name unless $@;
     }
@@ -408,7 +430,7 @@ command line tool consists of the following code:
 
     my $app = App::Prove->new;
     $app->process_args(@ARGV);
-    $app->run;
+    exit( $app->run ? 0 : 1 );  # if you need the exit code
 
 =cut
 
@@ -443,7 +465,7 @@ sub run {
 sub _get_tests {
     my $self = shift;
 
-    my $state = $self->{_state};
+    my $state = $self->state_manager;
     my $ext   = $self->extension;
     $state->extension($ext) if defined $ext;
     if ( defined( my $state_switch = $self->state ) ) {
@@ -462,15 +484,23 @@ sub _runtests {
     my ( $self, $args, $harness_class, @tests ) = @_;
     my $harness = $harness_class->new($args);
 
+    my $state = $self->state_manager;
+
     $harness->callback(
         after_test => sub {
-            $self->{_state}->observe_test(@_);
+            $state->observe_test(@_);
+        }
+    );
+
+    $harness->callback(
+        after_runtests => sub {
+            $state->commit(@_);
         }
     );
 
     my $aggregator = $harness->runtests(@tests);
 
-    return $aggregator->has_problems ? 0 : 1;
+    return !$aggregator->has_errors;
 }
 
 sub _get_switches {
@@ -633,6 +663,8 @@ calling C<run>.
 
 =item C<rules>
 
+=item C<show_count>
+
 =item C<show_help>
 
 =item C<show_man>
index aeac643..2b284d2 100644 (file)
@@ -6,6 +6,8 @@ use vars qw($VERSION @ISA);
 use File::Find;
 use File::Spec;
 use Carp;
+
+use App::Prove::State::Result;
 use TAP::Parser::YAMLish::Reader ();
 use TAP::Parser::YAMLish::Writer ();
 use TAP::Base;
@@ -21,11 +23,11 @@ App::Prove::State - State storage for the C<prove> command.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
@@ -54,10 +56,11 @@ sub new {
     my %args = %{ shift || {} };
 
     my $self = bless {
-        _ => {
-            tests      => {},
-            generation => 1
-        },
+        _ => $class->result_class->new(
+            {   tests      => {},
+                generation => 1,
+            }
+        ),
         select    => [],
         seq       => 1,
         store     => delete $args{store},
@@ -71,6 +74,18 @@ sub new {
     return $self;
 }
 
+=head2 C<result_class>
+
+Returns the name of the class used for tracking test results.  This class
+should either subclass from C<App::Prove::State::Result> or provide an
+identical interface.
+
+=cut
+
+sub result_class {
+    return 'App::Prove::State::Result';
+}
+
 =head2 C<extension>
 
 Get or set the extension files must have in order to be considered
@@ -84,7 +99,24 @@ sub extension {
     return $self->{extension};
 }
 
-sub DESTROY {
+=head2 C<results>
+
+Get the results of the last test run.  Returns a C<result_class()> instance.
+
+=cut
+
+sub results {
+    my $self = shift;
+    $self->{_} || $self->result_class->new 
+}
+
+=head2 C<commit>
+
+Save the test results. Should be called after all tests have run.
+
+=cut
+
+sub commit {
     my $self = shift;
     if ( $self->{should_save} && defined( my $store = $self->{store} ) ) {
         $self->save($store);
@@ -151,53 +183,57 @@ sub apply_switch {
     my $self = shift;
     my @opts = @_;
 
-    my $last_gen = $self->{_}->{generation} - 1;
-    my $now      = $self->get_time;
+    my $last_gen      = $self->results->generation - 1;
+    my $last_run_time = $self->results->last_run_time;
+    my $now           = $self->get_time;
 
     my @switches = map { split /,/ } @opts;
 
     my %handler = (
         last => sub {
             $self->_select(
-                where => sub { $_->{gen} >= $last_gen },
-                order => sub { $_->{seq} }
+                where => sub { $_->generation >= $last_gen },
+                order => sub { $_->sequence }
             );
         },
         failed => sub {
             $self->_select(
-                where => sub { $_->{last_result} != 0 },
-                order => sub { -$_->{last_result} }
+                where => sub { $_->result != 0 },
+                order => sub { -$_->result }
             );
         },
         passed => sub {
-            $self->_select( where => sub { $_->{last_result} == 0 } );
+            $self->_select( where => sub { $_->result == 0 } );
         },
         all => sub {
             $self->_select();
         },
         todo => sub {
             $self->_select(
-                where => sub { $_->{last_todo} != 0 },
-                order => sub { -$_->{last_todo}; }
+                where => sub { $_->num_todo != 0 },
+                order => sub { -$_->num_todo; }
             );
         },
         hot => sub {
             $self->_select(
-                where => sub { defined $_->{last_fail_time} },
-                order => sub { $now - $_->{last_fail_time} }
+                where => sub { defined $_->last_fail_time },
+                order => sub { $now - $_->last_fail_time }
             );
         },
         slow => sub {
-            $self->_select( order => sub { -$_->{elapsed} } );
+            $self->_select( order => sub { -$_->elapsed } );
         },
         fast => sub {
-            $self->_select( order => sub { $_->{elapsed} } );
+            $self->_select( order => sub { $_->elapsed } );
         },
         new => sub {
-            $self->_select( order => sub { -$_->{mtime} } );
+            $self->_select( order => sub { -$_->mtime } );
         },
         old => sub {
-            $self->_select( order => sub { $_->{mtime} } );
+            $self->_select( order => sub { $_->mtime } );
+        },
+        fresh => sub {
+            $self->_select( where => sub { $_->mtime >= $last_run_time } );
         },
         save => sub {
             $self->{should_save}++;
@@ -251,7 +287,7 @@ sub _query {
     my $self = shift;
     if ( my @sel = @{ $self->{select} } ) {
         warn "No saved state, selection will be empty\n"
-          unless keys %{ $self->{_}->{tests} };
+          unless $self->results->num_tests;
         return map { $self->_query_clause($_) } @sel;
     }
     return;
@@ -260,14 +296,14 @@ sub _query {
 sub _query_clause {
     my ( $self, $clause ) = @_;
     my @got;
-    my $tests = $self->{_}->{tests};
+    my $results = $self->results;
     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->();
+    for my $name ( $results->test_names ) {
+        next unless -f $name;
+        local $_ = $results->test($name);
+        push @got, $name if $where->();
     }
 
     # Sort
@@ -278,7 +314,7 @@ sub _query_clause {
               || ( ( $a->[1] || 0 ) <=> ( $b->[1] || 0 ) )
           } map {
             [   $_,
-                do { local $_ = $tests->{$_}; $order->() }
+                do { local $_ = $results->test($_); $order->() }
             ]
           } @got;
     }
@@ -318,8 +354,9 @@ sub _expand_dir_recursive {
 
     my @tests;
     find(
-        {   follow => 1,      #21938
-            wanted => sub {
+        {   follow      => 1,      #21938
+            follow_skip => 2,
+            wanted      => sub {
                 -f 
                   && /\Q$extension\E$/
                   && push @tests => $File::Find::name;
@@ -339,8 +376,9 @@ Store the results of a test.
 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
+        $test->[0],
+        scalar( $parser->failed ) + ( $parser->has_problems ? 1 : 0 ),
+        scalar( $parser->todo ), $parser->start_time, $parser->end_time,
     );
 }
 
@@ -355,24 +393,24 @@ sub observe_test {
 #     state generation
 
 sub _record_test {
-    my ( $self, $test, $fail, $todo, $start_time, $end_time ) = @_;
-    my $rec = $self->{_}->{tests}->{ $test->[0] } ||= {};
+    my ( $self, $name, $fail, $todo, $start_time, $end_time ) = @_;
+    my $test = $self->results->test($name);
 
-    $rec->{seq} = $self->{seq}++;
-    $rec->{gen} = $self->{_}->{generation};
+    $test->sequence( $self->{seq}++ );
+    $test->generation( $self->results->generation );
 
-    $rec->{last_run_time} = $end_time;
-    $rec->{last_result}   = $fail;
-    $rec->{last_todo}     = $todo;
-    $rec->{elapsed}       = $end_time - $start_time;
+    $test->run_time($end_time);
+    $test->result($fail);
+    $test->num_todo($todo);
+    $test->elapsed( $end_time - $start_time );
 
     if ($fail) {
-        $rec->{total_failures}++;
-        $rec->{last_fail_time} = $end_time;
+        $test->total_failures( $test->total_failures + 1 );
+        $test->last_fail_time($end_time);
     }
     else {
-        $rec->{total_passes}++;
-        $rec->{last_pass_time} = $end_time;
+        $test->total_passes( $test->total_passes + 1 );
+        $test->last_pass_time($end_time);
     }
 }
 
@@ -384,10 +422,13 @@ Write the state to a file.
 
 sub save {
     my ( $self, $name ) = @_;
+
+    $self->results->last_run_time( $self->get_time );
+
     my $writer = TAP::Parser::YAMLish::Writer->new;
     local *FH;
     open FH, ">$name" or croak "Can't write $name ($!)";
-    $writer->write( $self->{_} || {}, \*FH );
+    $writer->write( $self->results->raw, \*FH );
     close FH;
 }
 
@@ -402,37 +443,47 @@ sub load {
     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;
-        }
+
+    # XXX this is temporary
+    $self->{_} = $self->result_class->new(
+        $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}++;
+    $self->results->generation( $self->results->generation + 1 );
 }
 
 sub _prune_and_stamp {
     my $self = shift;
-    for my $name ( keys %{ $self->{_}->{tests} || {} } ) {
+
+    my $results = $self->results;
+    my @tests   = $self->results->tests;
+    for my $test (@tests) {
+        my $name = $test->name;
         if ( my @stat = stat $name ) {
-            $self->{_}->{tests}->{$name}->{mtime} = $stat[9];
+            $test->mtime( $stat[9] );
         }
         else {
-            delete $self->{_}->{tests}->{$name};
+            $results->remove($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};
+    for my $test ( $self->results->tests ) {
+        $self->{seq} = $test->sequence + 1
+          if defined $test->sequence && $test->sequence >= $self->{seq};
     }
 }
+
+1;
diff --git a/ext/Test/Harness/lib/App/Prove/State/Result.pm b/ext/Test/Harness/lib/App/Prove/State/Result.pm
new file mode 100644 (file)
index 0000000..37337ea
--- /dev/null
@@ -0,0 +1,232 @@
+package App::Prove::State::Result;
+
+use strict;
+use Carp 'croak';
+
+use App::Prove::State::Result::Test;
+use vars qw($VERSION);
+
+use constant STATE_VERSION => 1;
+
+=head1 NAME
+
+App::Prove::State::Result - Individual test suite results.
+
+=head1 VERSION
+
+Version 3.14
+
+=cut
+
+$VERSION = '3.14';
+
+=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=fail,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;
+    foreach my $test ( $self->tests ) {
+        $tests{ $test->name } = $test->raw;
+    }
+    $raw{tests} = \%tests;
+    return \%raw;
+}
+
+1;
diff --git a/ext/Test/Harness/lib/App/Prove/State/Result/Test.pm b/ext/Test/Harness/lib/App/Prove/State/Result/Test.pm
new file mode 100644 (file)
index 0000000..50e2096
--- /dev/null
@@ -0,0 +1,146 @@
+package App::Prove::State::Result::Test;
+
+use strict;
+
+use vars qw($VERSION);
+
+=head1 NAME
+
+App::Prove::State::Result::Test - Individual test results.
+
+=head1 VERSION
+
+Version 3.14
+
+=cut
+
+$VERSION = '3.14';
+
+=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.
+
+=head1 SYNOPSIS
+
+    # Re-run failed tests
+    $ prove --state=fail,save -rbv
+
+=cut
+
+my %methods = (
+    name           => { method => 'name' },
+    elapsed        => { method => 'elapsed', default => 0 },
+    gen            => { method => 'generation', default => 1 },
+    last_pass_time => { method => 'last_pass_time', default => undef },
+    last_fail_time => { method => 'last_fail_time', default => undef },
+    last_result    => { method => 'result', default => 0 },
+    last_run_time  => { method => 'run_time', default => undef },
+    last_todo      => { method => 'num_todo', default => 0 },
+    mtime          => { method => 'mtime', default => undef },
+    seq            => { method => 'sequence', default => 1 },
+    total_passes   => { method => 'total_passes', default => 0 },
+    total_failures => { method => 'total_failures', default => 0 },
+);
+
+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;
+    };
+}
+
+=head1 METHODS
+
+=head2 Class Methods
+
+=head3 C<new>
+
+=cut
+
+sub new {
+    my ( $class, $arg_for ) = @_;
+    $arg_for ||= {};
+    bless $arg_for => $class;
+}
+
+=head2 Instance Methods
+
+=head3 C<name>
+
+The name of the test.  Usually a filename.
+
+=head3 C<elapsed>
+
+The total elapsed times the test took to run, in seconds from the epoch..
+
+=head3 C<generation>
+
+The number for the "generation" of the test run.  The first generation is 1
+(one) and subsequent generations are 2, 3, etc.
+
+=head3 C<last_pass_time>
+
+The last time the test program passed, in seconds from the epoch.
+
+Returns C<undef> if the program has never passed.
+
+=head3 C<last_fail_time>
+
+The last time the test suite failed, in seconds from the epoch.
+
+Returns C<undef> if the program has never failed.
+
+=head3 C<mtime>
+
+Returns the mtime of the test, in seconds from the epoch.
+
+=head3 C<raw>
+
+Returns a hashref of raw test data, suitable for serialization by YAML.
+
+=head3 C<result>
+
+Currently, whether or not the test suite passed with no 'problems' (such as
+TODO passed).
+
+=head3 C<run_time>
+
+The total time it took for the test to run, in seconds.  If C<Time::HiRes> is
+available, it will have finer granularity.
+
+=head3 C<num_todo>
+
+The number of tests with TODO directives.
+
+=head3 C<sequence>
+
+The order in which this test was run for the given test suite result. 
+
+=head3 C<total_passes>
+
+The number of times the test has passed.
+
+=head3 C<total_failures>
+
+The number of times the test has failed.
+
+=cut
+
+sub raw {
+    my $self = shift;
+    my %raw  = %$self;
+
+    # this is backwards-compatibility hack and is not gauranteed.
+    delete $raw{name};
+    return \%raw;
+}
+
+1;
index 0745034..25d4ce2 100644 (file)
@@ -13,11 +13,11 @@ TAP::Base - Base class that provides common functionality to L<TAP::Parser> and
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 my $GOT_TIME_HIRES;
 
index 532f279..8558854 100644 (file)
@@ -71,11 +71,11 @@ TAP::Formatter::Color - Run Perl test scripts with color
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index 05384f0..beacf9f 100644 (file)
@@ -20,6 +20,7 @@ BEGIN {
         errors     => sub { shift; shift },
         color      => sub { shift; shift },
         jobs       => sub { shift; shift },
+        show_count => sub { shift; shift },
         stdout     => sub {
             my ( $self, $ref ) = @_;
             $self->_croak("option 'stdout' needs a filehandle")
@@ -51,11 +52,11 @@ TAP::Formatter::Console - Harness output delegate for default console output
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
@@ -179,6 +180,11 @@ the current platform and output is not being redirected.
 
 The number of concurrent jobs this formatter will handle.
 
+=item * C<show_count>
+
+Boolean value.  If false, disables the C<X/Y> test count which shows up while
+tests are running.
+
 =back
 
 Any keys for which the value is C<undef> will be ignored.
@@ -250,9 +256,10 @@ sub open_test {
     $self->_croak($@) if $@;
 
     my $session = $class->new(
-        {   name      => $test,
-            formatter => $self,
-            parser    => $parser
+        {   name       => $test,
+            formatter  => $self,
+            parser     => $parser,
+            show_count => $self->show_count,
         }
     );
 
index a509cf7..eae6598 100644 (file)
@@ -36,27 +36,22 @@ sub _create_shared_context {
     };
 }
 
-sub _need_refresh {
-    my $self      = shift;
-    my $formatter = $self->formatter;
-    $shared{$formatter}->{need_refresh}++;
-}
-
 =head1 NAME
 
 TAP::Formatter::Console::ParallelSession - Harness output delegate for parallel console output
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
-This provides console orientated output formatting for L<TAP::Harness::Parallel>.
+This provides console orientated output formatting for L<TAP::Harness>
+when run with multiple L<TAP::Harness/jobs>.
 
 =head1 SYNOPSIS
 
@@ -73,28 +68,49 @@ Output test preamble
 =cut
 
 sub header {
-    my $self = shift;
-    $self->_need_refresh;
-}
-
-sub _refresh {
 }
 
-sub _clear_line {
+sub _clear_ruler {
     my $self = shift;
     $self->formatter->_output( "\r" . ( ' ' x WIDTH ) . "\r" );
 }
 
+my $now = 0;
+my $start;
+
+my $trailer = '... )===';
+my $chop_length = WIDTH - length $trailer;
+
 sub _output_ruler {
-    my $self      = shift;
+    my ($self, $refresh) = @_;
+    my $new_now = time;
+    return if $new_now == $now and !$refresh;
+    $now = $new_now;
+    $start ||= $now;
     my $formatter = $self->formatter;
     return if $formatter->really_quiet;
 
     my $context = $shared{$formatter};
 
-    my $ruler = sprintf( "===( %7d )", $context->{tests} );
-    $ruler .= ( '=' x ( WIDTH - length $ruler ) );
-    $formatter->_output("\r$ruler");
+    my $ruler = sprintf '===( %7d;%d  ', $context->{tests}, $now - $start;
+
+    foreach my $active ( @{$context->{active}} ) {
+       my $parser = $active->parser;
+       my $tests = $parser->tests_run;
+       my $planned = $parser->tests_planned || '?';
+
+       $ruler .= sprintf '%' . length ($planned) . "d/$planned  ", $tests;
+    }
+    chop $ruler; # Remove a trailing space
+    $ruler .= ')===';
+
+    if ( length $ruler > WIDTH ) {
+       $ruler =~ s/(.{$chop_length}).*/$1$trailer/o;
+    }
+    else {
+       $ruler .= '=' x ( WIDTH - length( $ruler ) );
+    }
+    $formatter->_output( "\r$ruler");
 }
 
 =head3 C<result>
@@ -105,33 +121,45 @@ sub _output_ruler {
 
 sub result {
     my ( $self, $result ) = @_;
-    my $parser    = $self->parser;
     my $formatter = $self->formatter;
-    my $context   = $shared{$formatter};
-
-    $self->_refresh;
 
     # my $really_quiet = $formatter->really_quiet;
     # my $show_count   = $self->_should_show_count;
-    my $planned = $parser->tests_planned;
 
-    if ( $result->is_bailout ) {
+    if ( $result->is_test ) {
+        my $context = $shared{$formatter};
+        $context->{tests}++;
+
+       my $active = $context->{active};
+       if ( @$active == 1 ) {
+            # There is only one test, so use the serial output format.
+            return $self->SUPER::result( $result );
+        }
+
+       $self->_output_ruler( $self->parser->tests_run == 1 );
+    }
+    elsif ( $result->is_bailout ) {
         $formatter->_failure_output(
                 "Bailout called.  Further testing stopped:  "
               . $result->explanation
               . "\n" );
     }
+}
 
-    if ( $result->is_test ) {
-        $context->{tests}++;
+=head3 C<clear_for_close>
 
-        my $test_print_modulus = 1;
-        my $ceiling            = $context->{tests} / 5;
-        $test_print_modulus *= 2 while $test_print_modulus < $ceiling;
+=cut
 
-        unless ( $context->{tests} % $test_print_modulus ) {
-            $self->_output_ruler;
-        }
+sub clear_for_close {
+    my $self      = shift;
+    my $formatter = $self->formatter;
+    return if $formatter->really_quiet;
+    my $context   = $shared{$formatter};
+    if ( @{ $context->{active} } == 1 ) {
+       $self->SUPER::clear_for_close;
+    }
+    else {
+       $self->_clear_ruler;
     }
 }
 
@@ -146,27 +174,8 @@ sub close_test {
     my $formatter = $self->formatter;
     my $context   = $shared{$formatter};
 
-    unless ( $formatter->really_quiet ) {
-        $self->_clear_line;
+    $self->SUPER::close_test;
 
-        # my $output = $self->_output_method;
-        $formatter->_output(
-            $formatter->_format_name( $self->name ),
-            ' '
-        );
-    }
-
-    if ( $parser->has_problems ) {
-        $self->_output_test_failure($parser);
-    }
-    else {
-        $formatter->_output("ok\n")
-          unless $formatter->really_quiet;
-    }
-
-    $self->_output_ruler;
-
-    # $self->SUPER::close_test;
     my $active = $context->{active};
 
     my @pos = grep { $active->[$_]->name eq $name } 0 .. $#$active;
@@ -174,10 +183,14 @@ sub close_test {
     die "Can't find myself" unless @pos;
     splice @$active, $pos[0], 1;
 
-    $self->_need_refresh;
-
-    unless (@$active) {
-
+    if (@$active > 1) {
+        $self->_output_ruler( 1 );
+    }
+    elsif (@$active == 1) {
+        # Print out "test/name.t ...."
+        $active->[0]->SUPER::header;
+    }
+    else {
         # $self->formatter->_output("\n");
         delete $shared{$formatter};
     }
index 0c14f00..074407b 100644 (file)
@@ -11,14 +11,14 @@ my @ACCESSOR;
 
 BEGIN {
 
-    @ACCESSOR = qw( name formatter parser );
+    @ACCESSOR = qw( name formatter parser show_count );
 
     for my $method (@ACCESSOR) {
         no strict 'refs';
         *$method = sub { shift->{$method} };
     }
 
-    my @CLOSURE_BINDING = qw( header result close_test );
+    my @CLOSURE_BINDING = qw( header result clear_for_close close_test );
 
     for my $method (@CLOSURE_BINDING) {
         no strict 'refs';
@@ -36,11 +36,11 @@ TAP::Formatter::Console::Session - Harness output delegate for default console o
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
@@ -71,6 +71,8 @@ The constructor returns a new C<TAP::Formatter::Console::Session> object.
 
 =item * C<name>
 
+=item * C<show_count>
+
 =back
 
 =cut
@@ -86,6 +88,13 @@ sub _initialize {
         $self->{$name} = delete $arg_for{$name};
     }
 
+    if ( !defined $self->show_count ) {
+        $self->{show_count} = 1;    # defaults to true
+    }
+    if ( $self->show_count ) {      # but may be a damned lie!
+        $self->{show_count} = $self->_should_show_count;
+    }
+
     if ( my @props = sort keys %arg_for ) {
         $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
     }
@@ -105,6 +114,11 @@ Called by the harness for each line of TAP it receives.
 
 Called to close a test session.
 
+=head3 C<clear_for_close>
+
+Called by C<close_test> to clear the line showing test progress, or the parallel
+test ruler, prior to printing the final test result.
+
 =cut
 
 sub _get_output_result {
@@ -151,8 +165,8 @@ sub _closures {
 
     my $parser     = $self->parser;
     my $formatter  = $self->formatter;
-    my $show_count = $self->_should_show_count;
     my $pretty     = $formatter->_format_name( $self->name );
+    my $show_count = $self->show_count;
 
     my $really_quiet = $formatter->really_quiet;
     my $quiet        = $formatter->quiet;
@@ -202,10 +216,11 @@ sub _closures {
                 my $number = $result->number;
                 my $now    = CORE::time;
 
-                # Print status on first number, and roughly once per second
-                if (   ( $number == 1 )
-                    || ( $last_status_printed != $now ) )
-                {
+                # Print status roughly once per second.
+               # We will always get the first number as a side effect of
+               # $last_status_printed starting with the value 0, which $now
+               # will never be. (Unless someone sets their clock to 1970)
+                if ( $last_status_printed != $now ) {
                     $formatter->$output("\r$pretty$number$plan");
                     $last_status_printed = $now;
                 }
@@ -226,7 +241,17 @@ sub _closures {
             }
         },
 
+        clear_for_close => sub {
+            my $spaces = ' ' x
+              length( '.' . $pretty . $plan . $parser->tests_run );
+            $formatter->$output("\r$spaces");
+        },
+            
         close_test => sub {
+            if ($show_count && !$really_quiet) {
+                $self->clear_for_close;
+                $formatter->$output("\r$pretty");
+            }
 
             # Avoid circular references
             $self->parser(undef);
@@ -234,12 +259,6 @@ sub _closures {
 
             return if $really_quiet;
 
-            if ($show_count) {
-                my $spaces = ' ' x
-                  length( '.' . $pretty . $plan . $parser->tests_run );
-                $formatter->$output("\r$spaces\r$pretty");
-            }
-
             if ( my $skip_all = $parser->skip_all ) {
                 $formatter->_output("skipped: $skip_all\n");
             }
index 774152a..27961cc 100644 (file)
@@ -8,10 +8,6 @@ use File::Path;
 use IO::Handle;
 
 use TAP::Base;
-use TAP::Parser;
-use TAP::Parser::Aggregator;
-use TAP::Parser::Multiplexer;
-use TAP::Parser::Scheduler;
 
 use vars qw($VERSION @ISA);
 
@@ -23,11 +19,11 @@ TAP::Harness - Run test scripts with statistics
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 $ENV{HARNESS_ACTIVE}  = 1;
 $ENV{HARNESS_VERSION} = $VERSION;
@@ -64,7 +60,7 @@ sub _error {
 BEGIN {
 
     @FORMATTER_ARGS = qw(
-      directives verbosity timer failures errors stdout color
+      directives verbosity timer failures errors stdout color show_count
     );
 
     %VALIDATION_FOR = (
@@ -74,16 +70,20 @@ BEGIN {
 
             return [ map {"-I$_"} @$libs ];
         },
-        switches        => sub { shift; shift },
-        exec            => sub { shift; shift },
-        merge           => sub { shift; shift },
-        formatter_class => sub { shift; shift },
-        formatter       => sub { shift; shift },
-        jobs            => sub { shift; shift },
-        fork            => sub { shift; shift },
-        test_args       => sub { shift; shift },
-        ignore_exit     => sub { shift; shift },
-        rules           => sub { shift; shift },
+        switches          => sub { shift; shift },
+        exec              => sub { shift; shift },
+        merge             => sub { shift; shift },
+        aggregator_class  => sub { shift; shift },
+        formatter_class   => sub { shift; shift },
+        multiplexer_class => sub { shift; shift },
+        parser_class      => sub { shift; shift },
+        scheduler_class   => sub { shift; shift },
+        formatter         => sub { shift; shift },
+        jobs              => sub { shift; shift },
+        fork              => sub { shift; shift },
+        test_args         => sub { shift; shift },
+        ignore_exit       => sub { shift; shift },
+        rules             => sub { shift; shift },
     );
 
     for my $method ( sort keys %VALIDATION_FOR ) {
@@ -137,8 +137,8 @@ BEGIN {
  )
  my $harness = TAP::Harness->new( \%args );
 
-The constructor returns a new C<TAP::Harness> object.  It accepts an optional
-hashref whose allowed keys are:
+The constructor returns a new C<TAP::Harness> object. It accepts an
+optional hashref whose allowed keys are:
 
 =over 4
 
@@ -151,26 +151,33 @@ Set the verbosity level:
     -1   quiet          Suppress some test output (mostly failures 
                         while tests are running).
     -2   really quiet   Suppress everything but the tests summary.
+    -3   silent         Suppress everything.
 
 =item * C<timer>
 
-Append run time for each test to output. Uses L<Time::HiRes> if available.
+Append run time for each test to output. Uses L<Time::HiRes> if
+available.
 
 =item * C<failures>
 
 Only show test failures (this is a no-op if C<verbose> is selected).
 
+=item * C<show_count>
+
+Update the running test count during testing.
+
 =item * C<lib>
 
-Accepts a scalar value or array ref of scalar values indicating which paths to
-allowed libraries should be included if Perl tests are executed.  Naturally,
-this only makes sense in the context of tests written in Perl.
+Accepts a scalar value or array ref of scalar values indicating which
+paths to allowed libraries should be included if Perl tests are
+executed. Naturally, this only makes sense in the context of tests
+written in Perl.
 
 =item * C<switches>
 
-Accepts a scalar value or array ref of scalar values indicating which switches
-should be included if Perl tests are executed.  Naturally, this only makes
-sense in the context of tests written in Perl.
+Accepts a scalar value or array ref of scalar values indicating which
+switches should be included if Perl tests are executed. Naturally, this
+only makes sense in the context of tests written in Perl.
 
 =item * C<test_args>
 
@@ -183,37 +190,59 @@ Attempt to produce color output.
 
 =item * C<exec>
 
-Typically, Perl tests are run through this.  However, anything which spits out
-TAP is fine.  You can use this argument to specify the name of the program
-(and optional switches) to run your tests with:
+Typically, Perl tests are run through this. However, anything which
+spits out TAP is fine. You can use this argument to specify the name of
+the program (and optional switches) to run your tests with:
 
   exec => ['/usr/bin/ruby', '-w']
 
-You can also pass a subroutine reference in order to determine and return the
-proper program to run based on a given test script. The subroutine reference
-should expect the TAP::Harness object itself as the first argument, and the
-file name as the second argument. It should return an array reference
-containing the command to be run and including the test file name. It can also
-simply return C<undef>, in which case TAP::Harness will fall back on executing
-the test script in Perl:
-
-  exec => sub {
-      my ( $harness, $test_file ) = @_;
-      # Let Perl tests run.
-      return undef if $test_file =~ /[.]t$/;
-      return [ qw( /usr/bin/ruby -w ), $test_file ] if $test_file =~ /[.]rb$/;
-  }
+You can also pass a subroutine reference in order to determine and
+return the proper program to run based on a given test script. The
+subroutine reference should expect the TAP::Harness object itself as the
+first argument, and the file name as the second argument. It should
+return an array reference containing the command to be run and including
+the test file name. It can also simply return C<undef>, in which case
+TAP::Harness will fall back on executing the test script in Perl:
+
+    exec => sub {
+        my ( $harness, $test_file ) = @_;
+
+        # Let Perl tests run.
+        return undef if $test_file =~ /[.]t$/;
+        return [ qw( /usr/bin/ruby -w ), $test_file ]
+          if $test_file =~ /[.]rb$/;
+      }
 
 =item * C<merge>
 
 If C<merge> is true the harness will create parsers that merge STDOUT
 and STDERR together for any processes they start.
 
+=item * C<aggregator_class>
+
+The name of the class to use to aggregate test results. The default is
+L<TAP::Parser::Aggregator>.
+
 =item * C<formatter_class>
 
 The name of the class to use to format output. The default is
 L<TAP::Formatter::Console>.
 
+=item * C<multiplexer_class>
+
+The name of the class to use to multiplex tests during parallel testing.
+The default is L<TAP::Parser::Multiplexer>.
+
+=item * C<parser_class>
+
+The name of the class to use to parse TAP. The default is
+L<TAP::Parser>.
+
+=item * C<scheduler_class>
+
+The name of the class to use to schedule test execution. The default is
+L<TAP::Parser::Scheduler>.
+
 =item * C<formatter>
 
 If set C<formatter> must be an object that is capable of formatting the
@@ -221,22 +250,35 @@ TAP output. See L<TAP::Formatter::Console> for an example.
 
 =item * C<errors>
 
-If parse errors are found in the TAP output, a note of this will be made
-in the summary report.  To see all of the parse errors, set this argument to
-true:
+If parse errors are found in the TAP output, a note of this will be
+made in the summary report. To see all of the parse errors, set this
+argument to true:
 
   errors => 1
 
 =item * C<directives>
 
-If set to a true value, only test results with directives will be displayed.
-This overrides other settings such as C<verbose> or C<failures>.
+If set to a true value, only test results with directives will be
+displayed. This overrides other settings such as C<verbose> or
+C<failures>.
 
 =item * C<ignore_exit>
 
 If set to a true value instruct C<TAP::Parser> to ignore exit and wait
 status from test scripts.
 
+=item * C<jobs>
+
+The maximum number of parallel tests to run at any time.  Which tests
+can be run in parallel is controlled by C<rules>.  The default is to
+run only one test at a time.
+
+=item * C<fork>
+
+If true the harness will attempt to fork and run the parser for each
+test in a separate process. Currently this option requires
+L<Parallel::Iterator> to be installed.
+
 =item * C<rules>
 
 A reference to a hash of rules that control which tests may be
@@ -275,6 +317,14 @@ Any keys for which the value is C<undef> will be ignored.
       after_test
     );
 
+    my %default_class = (
+        aggregator_class  => 'TAP::Parser::Aggregator',
+        formatter_class   => 'TAP::Formatter::Console',
+        multiplexer_class => 'TAP::Parser::Multiplexer',
+        parser_class      => 'TAP::Parser',
+        scheduler_class   => 'TAP::Parser::Scheduler',
+    );
+
     sub _initialize {
         my ( $self, $arg_for ) = @_;
         $arg_for ||= {};
@@ -297,16 +347,11 @@ Any keys for which the value is C<undef> will be ignored.
 
         $self->jobs(1) unless defined $self->jobs;
 
-        unless ( $self->formatter ) {
-
-            $self->formatter_class( my $class = $self->formatter_class
-                  || 'TAP::Formatter::Console' );
-
-            croak "Bad module name $class"
-              unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
+        while ( my ( $attr, $class ) = each %default_class ) {
+            $self->$attr( $self->$attr() || $class );
+        }
 
-            eval "require $class";
-            $self->_croak("Can't load $class") if $@;
+        unless ( $self->formatter ) {
 
             # This is a little bodge to preserve legacy behaviour. It's
             # pretty horrible that we know which args are destined for
@@ -318,7 +363,9 @@ Any keys for which the value is C<undef> will be ignored.
                 }
             }
 
-            $self->formatter( $class->new( \%formatter_args ) );
+            $self->formatter(
+                $self->_construct( $self->formatter_class, \%formatter_args )
+            );
         }
 
         if ( my @props = sort keys %arg_for ) {
@@ -337,10 +384,10 @@ Any keys for which the value is C<undef> will be ignored.
 
     $harness->runtests(@tests);
 
-Accepts and array of C<@tests> to be run.  This should generally be the names
-of test files, but this is not required.  Each element in C<@tests> will be
-passed to C<TAP::Parser::new()> as a C<source>.  See L<TAP::Parser> for more
-information.
+Accepts and array of C<@tests> to be run. This should generally be the
+names of test files, but this is not required. Each element in C<@tests>
+will be passed to C<TAP::Parser::new()> as a C<source>. See
+L<TAP::Parser> for more information.
 
 It is possible to provide aliases that will be displayed in place of the
 test name by supplying the test as a reference to an array containing
@@ -367,7 +414,7 @@ Returns a L<TAP::Parser::Aggregator> containing the test results.
 sub runtests {
     my ( $self, @tests ) = @_;
 
-    my $aggregate = TAP::Parser::Aggregator->new;
+    my $aggregate = $self->_construct( $self->aggregator_class );
 
     $self->_make_callback( 'before_runtests', $aggregate );
     $aggregate->start;
@@ -442,7 +489,7 @@ sub _aggregate_parallel {
     my ( $self, $aggregate, $scheduler ) = @_;
 
     my $jobs = $self->jobs;
-    my $mux  = TAP::Parser::Multiplexer->new;
+    my $mux  = $self->_construct( $self->multiplexer_class );
 
     RESULT: {
 
@@ -521,17 +568,20 @@ may be run using different C<TAP::Harness> settings. This is useful, for
 example, in the case where some tests should run in parallel but others
 are unsuitable for parallel execution.
 
-    my $formatter = TAP::Formatter::Console->new;
+    my $formatter   = TAP::Formatter::Console->new;
     my $ser_harness = TAP::Harness->new( { formatter => $formatter } );
-    my $par_harness = TAP::Harness->new( { formatter => $formatter,
-                                           jobs => 9 } );
+    my $par_harness = TAP::Harness->new(
+        {   formatter => $formatter,
+            jobs      => 9
+        }
+    );
     my $aggregator = TAP::Parser::Aggregator->new;
-    
+
     $aggregator->start();
     $ser_harness->aggregate_tests( $aggregator, @ser_tests );
     $par_harness->aggregate_tests( $aggregator, @par_tests );
     $aggregator->stop();
-    $formatter->summary( $aggregator );
+    $formatter->summary($aggregator);
 
 Note that for simpler testing requirements it will often be possible to
 replace the above code with a single call to C<runtests>.
@@ -615,7 +665,8 @@ that was passed to C<aggregate_tests>.
 
 sub make_scheduler {
     my ( $self, @tests ) = @_;
-    return TAP::Parser::Scheduler->new(
+    return $self->_construct(
+        $self->scheduler_class,
         tests => [ $self->_add_descriptions(@tests) ],
         rules => $self->rules
     );
@@ -623,9 +674,10 @@ sub make_scheduler {
 
 =head3 C<jobs>
 
-Returns the number of concurrent test runs the harness is handling. For the default
-harness this value is always 1. A parallel harness such as L<TAP::Harness::Parallel>
-will override this to return the number of jobs it is handling.
+Gets or sets the number of concurrent test runs the harness is handling.
+For the default harness this value is always 1. A parallel harness such
+as L<TAP::Harness::Parallel> will override this to return the number of
+jobs it is handling.
 
 =head3 C<fork>
 
@@ -639,8 +691,9 @@ L<Parallel::Iterator> to be installed.
 
 =head1 SUBCLASSING
 
-C<TAP::Harness> is designed to be (mostly) easy to subclass.  If you don't
-like how a particular feature functions, just override the desired methods.
+C<TAP::Harness> is designed to be (mostly) easy to subclass. If you
+don't like how a particular feature functions, just override the
+desired methods.
 
 =head2 Methods
 
@@ -653,21 +706,22 @@ subclass C<TAP::Harness>.
 
   $harness->summary( \%args );
 
-C<summary> prints the summary report after all tests are run.  The argument is
-a hashref with the following keys:
+C<summary> prints the summary report after all tests are run. The
+argument is a hashref with the following keys:
 
 =over 4
 
 =item * C<start>
 
-This is created with C<< Benchmark->new >> and it the time the tests started.
-You can print a useful summary time, if desired, with:
+This is created with C<< Benchmark->new >> and it the time the tests
+started. You can print a useful summary time, if desired, with:
 
-  $self->output(timestr( timediff( Benchmark->new, $start_time ), 'nop' ));
+    $self->output(
+        timestr( timediff( Benchmark->new, $start_time ), 'nop' ) );
 
 =item * C<tests>
 
-This is an array reference of all test names.  To get the L<TAP::Parser>
+This is an array reference of all test names. To get the L<TAP::Parser>
 object for individual tests:
 
  my $aggregate = $args->{aggregate};
@@ -721,7 +775,6 @@ overridden in subclasses.
 
     my ( $parser, $session ) = $harness->make_parser;
 
-
 =cut
 
 sub make_parser {
@@ -729,7 +782,7 @@ sub make_parser {
 
     my $args = $self->_get_parser_args($job);
     $self->_make_callback( 'parser_args', $args, $job->as_array_ref );
-    my $parser = TAP::Parser->new($args);
+    my $parser = $self->_construct( $self->parser_class, $args );
 
     $self->_make_callback( 'made_parser', $parser, $job->as_array_ref );
     my $session = $self->formatter->open_test( $job->description, $parser );
index 71a0a88..bbc7bfd 100644 (file)
@@ -9,11 +9,11 @@ TAP::Object - Base class that provides common functionality to all C<TAP::*> mod
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -93,5 +93,26 @@ sub _croak {
     return;
 }
 
+=head3 C<_construct>
+
+Create a new instance of the specified class.
+
+=cut
+
+sub _construct {
+    my ( $self, $class, @args ) = @_;
+
+    $self->_croak("Bad module name $class")
+      unless $class =~ /^ \w+ (?: :: \w+ ) *$/x;
+
+    unless ( $class->can('new') ) {
+        local $@;
+        eval "require $class";
+        $self->_croak("Can't load $class") if $@;
+    }
+
+    return $class->new(@args);
+}
+
 1;
 
index 62a8b51..c02f2ac 100644 (file)
@@ -22,11 +22,11 @@ TAP::Parser - Parse L<TAP|Test::Harness::TAP> output
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 my $DEFAULT_TAP_VERSION = 12;
 my $MAX_TAP_VERSION     = 13;
@@ -1850,6 +1850,8 @@ Leif Eriksen <leif dot eriksen at bigpond dot com>
 
 Steve Purkis <spurkis@cpan.org>
 
+Nicholas Clark <nick@ccl4.org>
+
 =head1 BUGS
 
 Please report any bugs or feature requests to
index 5ed7fdb..d6fad64 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Aggregator - Aggregate TAP::Parser results
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index d56d0cb..a644b07 100644 (file)
@@ -15,11 +15,11 @@ TAP::Parser::Grammar - A grammar for the Test Anything Protocol.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -148,8 +148,8 @@ my %language_for;
                     ( $desc, $dir, $explanation ) = ( $1, $2, $3 );
                 }
                 return $self->_make_test_token(
-                    $line,   $ok, $num, $desc,
-                    $dir, $explanation
+                    $line, $ok, $num, $desc,
+                    $dir,  $explanation
                 );
             },
         },
@@ -401,16 +401,15 @@ sub _make_plan_token {
 
 sub _make_test_token {
     my ( $self, $line, $ok, $num, $desc, $dir, $explanation ) = @_;
-    my %test = (
+    return {
         ok          => $ok,
         test_num    => $num,
         description => _trim($desc),
-        directive   => uc( defined $dir ? $dir : '' ),
+        directive   => ( defined $dir ? uc $dir : '' ),
         explanation => _trim($explanation),
         raw         => $line,
         type        => 'test',
-    );
-    return \%test;
+    };
 }
 
 sub _make_unknown_token {
index 0d471d9..d33a963 100644 (file)
@@ -13,11 +13,11 @@ TAP::Parser::Iterator - Internal base class for TAP::Parser Iterators
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index 3eef09a..4495bb8 100644 (file)
@@ -13,11 +13,11 @@ TAP::Parser::Iterator::Array - Internal TAP::Parser array Iterator
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index bcc3420..cc9786c 100644 (file)
@@ -17,11 +17,11 @@ TAP::Parser::Iterator::Process - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index 3f2febf..e71dfc4 100644 (file)
@@ -13,11 +13,11 @@ TAP::Parser::Iterator::Stream - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index b2c1cdd..7aa4e4d 100644 (file)
@@ -16,11 +16,11 @@ TAP::Parser::IteratorFactory - Internal TAP::Parser Iterator
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index f572756..2efeb30 100644 (file)
@@ -18,11 +18,11 @@ TAP::Parser::Multiplexer - Multiplex multiple TAP::Parsers
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index eb27a19..486c6ff 100644 (file)
@@ -26,11 +26,11 @@ TAP::Parser::Result - Base class for TAP::Parser output objects
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -68,8 +68,10 @@ sub _initialize {
     my ( $self, $token ) = @_;
     if ($token) {
 
-        # make a shallow copy of the token:
-        $self->{$_} = $token->{$_} for ( keys %$token );
+        # assign to a hash slice to make a shallow copy of the token.
+        # I guess we could assign to the hash as (by default) there are not
+        # contents, but that seems less helpful if someone wants to subclass us
+        @{$self}{keys %$token} = values %$token;
     }
     return $self;
 }
@@ -293,6 +295,6 @@ L<TAP::Parser::Result::Pragma>,
 L<TAP::Parser::Result::Test>,
 L<TAP::Parser::Result::Unknown>,
 L<TAP::Parser::Result::Version>,
-L<TAP::PARSER::RESULT::YAML>,
+L<TAP::Parser::Result::YAML>,
 
 =cut
index b20d031..a4c9bbd 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Bailout - Bailout result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index aaa78da..04a2ce0 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Comment - Comment result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index c851f22..3225586 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Plan - Plan result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index b89c713..b0ea82a 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Pragma - TAP pragma token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index b36a7ce..4c12f61 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Result::Test - Test result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index 47c888e..0316fb0 100644 (file)
@@ -14,11 +14,11 @@ TAP::Parser::Result::Unknown - Unknown result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index 62bac2e..3688f2b 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::Version - TAP syntax version token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index f1b99ef..d1e9cf6 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Result::YAML - YAML result token.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 DESCRIPTION
 
index bf4797f..5d33935 100644 (file)
@@ -30,11 +30,11 @@ TAP::Parser::ResultFactory - Factory for creating TAP::Parser output objects
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head2 DESCRIPTION
 
index e0dea76..c90432e 100644 (file)
@@ -12,11 +12,11 @@ TAP::Parser::Scheduler - Schedule tests during parallel testing
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -110,18 +110,70 @@ sub _rule_clause {
     );
 }
 
+sub _glob_to_regexp {
+    my ( $self, $glob ) = @_;
+    my $nesting;
+    my $pattern;
+
+    while (1) {
+        if ( $glob =~ /\G\*\*/gc ) {
+
+            # ** is any number of characters, including /, within a pathname
+            $pattern .= '.*?';
+        }
+        elsif ( $glob =~ /\G\*/gc ) {
+
+            # * is zero or more characters within a filename/directory name
+            $pattern .= '[^/]*';
+        }
+        elsif ( $glob =~ /\G\?/gc ) {
+
+            # ? is exactly one character within a filename/directory name
+            $pattern .= '[^/]';
+        }
+        elsif ( $glob =~ /\G\{/gc ) {
+
+            # {foo,bar,baz} is any of foo, bar or baz.
+            $pattern .= '(?:';
+            ++$nesting;
+        }
+        elsif ( $nesting and $glob =~ /\G,/gc ) {
+
+            # , is only special inside {}
+            $pattern .= '|';
+        }
+        elsif ( $nesting and $glob =~ /\G\}/gc ) {
+
+            # } that matches { is special. But unbalanced } are not.
+            $pattern .= ')';
+            --$nesting;
+        }
+        elsif ( $glob =~ /\G(\\.)/gc ) {
+
+            # A quoted literal
+            $pattern .= $1;
+        }
+        elsif ( $glob =~ /\G([\},])/gc ) {
+
+            # Sometimes meta characters
+            $pattern .= '\\' . $1;
+        }
+        else {
+
+            # Eat everything that is not a meta character.
+            $glob =~ /\G([^{?*\\\},]*)/gc;
+            $pattern .= quotemeta $1;
+        }
+        return $pattern if pos $glob == length $glob;
+    }
+}
+
 sub _expand {
     my ( $self, $name, $tests ) = @_;
 
-    $name =~ s{(\?|\*\*?|.)}{
-        $1 eq '?'  ? '[^/]'
-      : $1 eq '*'  ? '[^/]*'
-      : $1 eq '**' ? '.*?'
-      :             quotemeta($1);
-    }gex;
-
-    my $pattern = qr{^$name$};
-    my @match   = ();
+    my $pattern = $self->_glob_to_regexp($name);
+    $pattern = qr/^ $pattern $/x;
+    my @match = ();
 
     for ( my $ti = 0; $ti < @$tests; $ti++ ) {
         if ( $tests->[$ti]->filename =~ $pattern ) {
@@ -141,14 +193,16 @@ Get a list of all remaining tests.
 
 sub get_all {
     my $self = shift;
-    $self->_gather( $self->{schedule} );
+    my @all = $self->_gather( $self->{schedule} );
+    $self->{count} = @all;
+    @all;
 }
 
 sub _gather {
     my ( $self, $rule ) = @_;
     return unless defined $rule;
     return $rule unless 'ARRAY' eq ref $rule;
-    return map { $self->_gather($_) } grep {defined} map {@$_} @$rule;
+    return map { defined () ? $self->_gather($_) : () } map {@$_} @$rule;
 }
 
 =head3 C<get_job>
@@ -161,20 +215,25 @@ jobs but none are available to run right now.
 
 sub get_job {
     my $self = shift;
+    $self->{count} ||= $self->get_all;
     my @jobs = $self->_find_next_job( $self->{schedule} );
-    return $jobs[0] if @jobs;
+    if (@jobs) {
+       --$self->{count};
+       return $jobs[0];
+    }
 
-    # TODO: This isn't very efficient...
     return TAP::Parser::Scheduler::Spinner->new
-      if $self->get_all;
+      if $self->{count};
 
     return;
 }
 
 sub _not_empty {
     my $ar = shift;
-    return 1 unless defined $ar && 'ARRAY' eq ref $ar;
-    return 1 if grep { _not_empty($_) } @$ar;
+    return 1 unless 'ARRAY' eq ref $ar;
+    foreach (@$ar) {
+        return 1 if _not_empty($_);
+    }
     return;
 }
 
@@ -184,19 +243,27 @@ sub _find_next_job {
     my ( $self, $rule ) = @_;
 
     my @queue = ();
-    for my $seq (@$rule) {
-
+    my $index = 0;
+    while ($index < @$rule) {
+        my $seq = $rule->[$index];
         # Prune any exhausted items.
         shift @$seq while @$seq && _is_empty( $seq->[0] );
-        if ( @$seq && defined $seq->[0] ) {
-            if ( 'ARRAY' eq ref $seq->[0] ) {
-                push @queue, $seq;
-            }
-            else {
-                my $job = splice @$seq, 0, 1, undef;
-                $job->on_finish( sub { shift @$seq } );
-                return $job;
+        if ( @$seq ) {
+            if ( defined $seq->[0] ) {
+                if ( 'ARRAY' eq ref $seq->[0] ) {
+                    push @queue, $seq;
+                }
+                else {
+                    my $job = splice @$seq, 0, 1, undef;
+                    $job->on_finish( sub { shift @$seq } );
+                    return $job;
+                }
             }
+            ++$index;
+        }
+        else {
+            # Remove the empty sub-array from the array
+            splice @$rule, $index, 1;
         }
     }
 
index 2dc05e0..fe55faf 100644 (file)
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Job - A single testing job.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -43,7 +43,7 @@ sub new {
     return bless {
         filename    => $name,
         description => $desc,
-        context     => \@ctx,
+        @ctx ? ( context => \@ctx ) : (),
     }, $class;
 }
 
@@ -81,7 +81,7 @@ sub finish {
 
 sub filename    { shift->{filename} }
 sub description { shift->{description} }
-sub context     { @{ shift->{context} } }
+sub context     { @{ shift->{context} || [] } }
 
 =head3 C<as_array_ref>
 
@@ -91,7 +91,7 @@ For backwards compatibility in callbacks.
 
 sub as_array_ref {
     my $self = shift;
-    return [ $self->filename, $self->description, $self->context ];
+    return [ $self->filename, $self->description, $self->{context} ||= [] ];
 }
 
 =head3 C<is_spinner>
index 6a0fa60..25f1b4a 100644 (file)
@@ -10,11 +10,11 @@ TAP::Parser::Scheduler::Spinner - A no-op job.
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index 9fc97a9..3b10482 100644 (file)
@@ -17,11 +17,11 @@ TAP::Parser::Source - Stream output from some source
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index fd60a76..444b429 100644 (file)
@@ -8,6 +8,8 @@ use constant IS_WIN32 => ( $^O =~ /^(MS)?Win32$/ );
 use constant IS_VMS => ( $^O eq 'VMS' );
 
 use TAP::Parser::Source;
+use TAP::Parser::Utils qw( split_shell );
+
 @ISA = 'TAP::Parser::Source';
 
 =head1 NAME
@@ -16,11 +18,11 @@ TAP::Parser::Source::Perl - Stream Perl output
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
@@ -145,14 +147,14 @@ sub get_stream {
     # Taint mode ignores environment variables so we must retranslate
     # PERL5LIB as -I switches and place PERL5OPT on the command line
     # in order that it be seen.
-    if ( grep { $_ eq "-T" } @switches ) {
+    if ( grep { $_ eq "-T" || $_ eq "-t" } @switches ) {
         push @switches,
           $self->_libs2switches(
             split $path_pat,
             $ENV{PERL5LIB} || $ENV{PERLLIB} || ''
           );
 
-        push @switches, $ENV{PERL5OPT} || ();
+        push @switches, split_shell( $ENV{PERL5OPT} );
     }
 
     my @command = $self->_get_command_for_switches(@switches)
index 837c63e..85174c0 100644 (file)
@@ -13,11 +13,11 @@ TAP::Parser::Utils - Internal TAP::Parser utilities
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 =head1 SYNOPSIS
 
index fca56de..cc39350 100644 (file)
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA);
 use TAP::Object ();
 
 @ISA     = 'TAP::Object';
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 # TODO:
 #   Handle blessed object syntax
@@ -270,7 +270,7 @@ TAP::Parser::YAMLish::Reader - Read YAMLish data from iterator
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =head1 SYNOPSIS
 
index 5889ac1..98301a3 100644 (file)
@@ -6,7 +6,7 @@ use vars qw($VERSION @ISA);
 use TAP::Object ();
 
 @ISA     = 'TAP::Object';
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 my $ESCAPE_CHAR = qr{ [ \x00-\x1f \" ] }x;
 my $ESCAPE_KEY  = qr{ (?: ^\W ) | $ESCAPE_CHAR }x;
@@ -127,7 +127,7 @@ sub _write_obj {
             }
         }
         else {
-            die "Don't know how to enocde $ref";
+            die "Don't know how to encode $ref";
         }
     }
     else {
@@ -147,7 +147,7 @@ TAP::Parser::YAMLish::Writer - Write YAMLish data
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =head1 SYNOPSIS
 
index 4f0164e..24566ba 100644 (file)
@@ -44,11 +44,11 @@ Test::Harness - Run Perl standard test scripts with statistics
 
 =head1 VERSION
 
-Version 3.13
+Version 3.14
 
 =cut
 
-$VERSION = '3.13';
+$VERSION = '3.14';
 
 # Backwards compatibility for exportable variable names.
 *verbose  = *Verbose;
@@ -290,7 +290,7 @@ sub _filtered_inc {
     elsif (IS_WIN32) {
 
         # Lose any trailing backslashes in the Win32 paths
-        s/[\\\/+]$// foreach @inc;
+        s/[\\\/]+$// foreach @inc;
     }
 
     my @default_inc = _default_inc();
index c6d6a92..58d41bf 100644 (file)
@@ -3,7 +3,7 @@
 use strict;
 use lib 't/lib';
 
-use Test::More tests => 74;
+use Test::More tests => 78;
 
 BEGIN {
 
@@ -12,6 +12,8 @@ BEGIN {
       TAP::Parser
       App::Prove
       App::Prove::State
+      App::Prove::State::Result
+      App::Prove::State::Result::Test
       TAP::Base
       TAP::Formatter::Color
       TAP::Formatter::Console::ParallelSession
index b164f9b..759b664 100644 (file)
@@ -20,12 +20,15 @@ use Test::Harness;
     }
 
     my $sample_tests;
-    if ($ENV{PERL_CORE}) {
-       my $updir = File::Spec->updir;
-       $sample_tests = File::Spec->catdir( $updir, 'ext', 'Test', 'Harness', 't', 'sample-tests' );
-    } else {
-       my $curdir = File::Spec->curdir;
-       $sample_tests = File::Spec->catdir( $curdir, 't', 'sample-tests' );
+    if ( $ENV{PERL_CORE} ) {
+        my $updir = File::Spec->updir;
+        $sample_tests
+          = File::Spec->catdir( $updir, 'ext', 'Test', 'Harness', 't',
+            'sample-tests' );
+    }
+    else {
+        my $curdir = File::Spec->curdir;
+        $sample_tests = File::Spec->catdir( $curdir, 't', 'sample-tests' );
     }
 
     {
index 480d6d8..00fab13 100644 (file)
@@ -1,33 +1,35 @@
 #!/usr/bin/perl -w
 
 BEGIN {
-    if ($ENV{PERL_CORE}) {
-       # FIXME
-       print "1..0 # Skip until we figure out why it exists with no output just after the plan\n";
-       exit 0;
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+    else {
+        unshift @INC, 't/lib';
     }
 }
 
 use strict;
 
-use lib 't/lib';
+use lib 't/lib';
 
 use Test::More;
-
 use File::Spec;
-
 use Test::Harness qw(execute_tests);
 
 # unset this global when self-testing ('testcover' and etc issue)
 local $ENV{HARNESS_PERL_SWITCHES};
 
+my $TEST_DIR
+  = $ENV{PERL_CORE} ? '../ext/Test/Harness/t/sample-tests' : 't/sample-tests';
+
 {
 
     # if the harness wants to save the resulting TAP we shouldn't
     # do it for our internal calls
     local $ENV{PERL_TEST_HARNESS_DUMP_TAP} = 0;
 
-    my $TEST_DIR = 't/sample-tests';
     my $PER_LOOP = 4;
 
     my $results = {
@@ -58,110 +60,110 @@ local $ENV{HARNESS_PERL_SWITCHES};
               )
           ) => {
             'failed' => {
-                't/sample-tests/die' => {
+                "$TEST_DIR/die" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/die',
+                    'name'   => "$TEST_DIR/die",
                     'wstat'  => '256'
                 },
-                't/sample-tests/die_head_end' => {
+                "$TEST_DIR/die_head_end" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/die_head_end',
+                    'name'   => "$TEST_DIR/die_head_end",
                     'wstat'  => '256'
                 },
-                't/sample-tests/die_last_minute' => {
+                "$TEST_DIR/die_last_minute" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => 0,
                     'max'    => 4,
-                    'name'   => 't/sample-tests/die_last_minute',
+                    'name'   => "$TEST_DIR/die_last_minute",
                     'wstat'  => '256'
                 },
-                't/sample-tests/duplicates' => {
+                "$TEST_DIR/duplicates" => {
                     'canon'  => '??',
                     'estat'  => '',
                     'failed' => '??',
                     'max'    => 10,
-                    'name'   => 't/sample-tests/duplicates',
+                    'name'   => "$TEST_DIR/duplicates",
                     'wstat'  => ''
                 },
-                't/sample-tests/head_fail' => {
+                "$TEST_DIR/head_fail" => {
                     'canon'  => 2,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 4,
-                    'name'   => 't/sample-tests/head_fail',
+                    'name'   => "$TEST_DIR/head_fail",
                     'wstat'  => ''
                 },
-                't/sample-tests/inc_taint' => {
+                "$TEST_DIR/inc_taint" => {
                     'canon'  => 1,
                     'estat'  => 1,
                     'failed' => 1,
                     'max'    => 1,
-                    'name'   => 't/sample-tests/inc_taint',
+                    'name'   => "$TEST_DIR/inc_taint",
                     'wstat'  => '256'
                 },
-                't/sample-tests/no_nums' => {
+                "$TEST_DIR/no_nums" => {
                     'canon'  => 3,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 5,
-                    'name'   => 't/sample-tests/no_nums',
+                    'name'   => "$TEST_DIR/no_nums",
                     'wstat'  => ''
                 },
-                't/sample-tests/no_output' => {
+                "$TEST_DIR/no_output" => {
                     'canon'  => '??',
                     'estat'  => '',
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/no_output',
+                    'name'   => "$TEST_DIR/no_output",
                     'wstat'  => ''
                 },
-                't/sample-tests/simple_fail' => {
+                "$TEST_DIR/simple_fail" => {
                     'canon'  => '2 5',
                     'estat'  => '',
                     'failed' => 2,
                     'max'    => 5,
-                    'name'   => 't/sample-tests/simple_fail',
+                    'name'   => "$TEST_DIR/simple_fail",
                     'wstat'  => ''
                 },
-                't/sample-tests/todo_misparse' => {
+                "$TEST_DIR/todo_misparse" => {
                     'canon'  => 1,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 1,
-                    'name'   => 't/sample-tests/todo_misparse',
+                    'name'   => "$TEST_DIR/todo_misparse",
                     'wstat'  => ''
                 },
-                't/sample-tests/too_many' => {
+                "$TEST_DIR/too_many" => {
                     'canon'  => '4-7',
                     'estat'  => 4,
                     'failed' => 4,
                     'max'    => 3,
-                    'name'   => 't/sample-tests/too_many',
+                    'name'   => "$TEST_DIR/too_many",
                     'wstat'  => '1024'
                 },
-                't/sample-tests/vms_nit' => {
+                "$TEST_DIR/vms_nit" => {
                     'canon'  => 1,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 2,
-                    'name'   => 't/sample-tests/vms_nit',
+                    'name'   => "$TEST_DIR/vms_nit",
                     'wstat'  => ''
                 }
             },
             'todo' => {
-                't/sample-tests/todo_inline' => {
+                "$TEST_DIR/todo_inline" => {
                     'canon'  => 2,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 2,
-                    'name'   => 't/sample-tests/todo_inline',
+                    'name'   => "$TEST_DIR/todo_inline",
                     'wstat'  => ''
                 }
             },
@@ -180,12 +182,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
           },
         'die' => {
             'failed' => {
-                't/sample-tests/die' => {
+                "$TEST_DIR/die" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/die',
+                    'name'   => "$TEST_DIR/die",
                     'wstat'  => '256'
                 }
             },
@@ -205,12 +207,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'die_head_end' => {
             'failed' => {
-                't/sample-tests/die_head_end' => {
+                "$TEST_DIR/die_head_end" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/die_head_end',
+                    'name'   => "$TEST_DIR/die_head_end",
                     'wstat'  => '256'
                 }
             },
@@ -230,12 +232,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'die_last_minute' => {
             'failed' => {
-                't/sample-tests/die_last_minute' => {
+                "$TEST_DIR/die_last_minute" => {
                     'canon'  => '??',
                     'estat'  => 1,
                     'failed' => 0,
                     'max'    => 4,
-                    'name'   => 't/sample-tests/die_last_minute',
+                    'name'   => "$TEST_DIR/die_last_minute",
                     'wstat'  => '256'
                 }
             },
@@ -255,12 +257,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'duplicates' => {
             'failed' => {
-                't/sample-tests/duplicates' => {
+                "$TEST_DIR/duplicates" => {
                     'canon'  => '??',
                     'estat'  => '',
                     'failed' => '??',
                     'max'    => 10,
-                    'name'   => 't/sample-tests/duplicates',
+                    'name'   => "$TEST_DIR/duplicates",
                     'wstat'  => ''
                 }
             },
@@ -296,12 +298,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'head_fail' => {
             'failed' => {
-                't/sample-tests/head_fail' => {
+                "$TEST_DIR/head_fail" => {
                     'canon'  => 2,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 4,
-                    'name'   => 't/sample-tests/head_fail',
+                    'name'   => "$TEST_DIR/head_fail",
                     'wstat'  => ''
                 }
             },
@@ -321,12 +323,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'inc_taint' => {
             'failed' => {
-                't/sample-tests/inc_taint' => {
+                "$TEST_DIR/inc_taint" => {
                     'canon'  => 1,
                     'estat'  => 1,
                     'failed' => 1,
                     'max'    => 1,
-                    'name'   => 't/sample-tests/inc_taint',
+                    'name'   => "$TEST_DIR/inc_taint",
                     'wstat'  => '256'
                 }
             },
@@ -378,12 +380,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'no_nums' => {
             'failed' => {
-                't/sample-tests/no_nums' => {
+                "$TEST_DIR/no_nums" => {
                     'canon'  => 3,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 5,
-                    'name'   => 't/sample-tests/no_nums',
+                    'name'   => "$TEST_DIR/no_nums",
                     'wstat'  => ''
                 }
             },
@@ -403,12 +405,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'no_output' => {
             'failed' => {
-                't/sample-tests/no_output' => {
+                "$TEST_DIR/no_output" => {
                     'canon'  => '??',
                     'estat'  => '',
                     'failed' => '??',
                     'max'    => '??',
-                    'name'   => 't/sample-tests/no_output',
+                    'name'   => "$TEST_DIR/no_output",
                     'wstat'  => ''
                 }
             },
@@ -492,12 +494,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'simple_fail' => {
             'failed' => {
-                't/sample-tests/simple_fail' => {
+                "$TEST_DIR/simple_fail" => {
                     'canon'  => '2 5',
                     'estat'  => '',
                     'failed' => 2,
                     'max'    => 5,
-                    'name'   => 't/sample-tests/simple_fail',
+                    'name'   => "$TEST_DIR/simple_fail",
                     'wstat'  => ''
                 }
             },
@@ -600,12 +602,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
                 ( $ENV{PERL5OPT} || '' ) =~ m{(?:^|\s)-[dM]};
             },
             'failed' => {
-                't/sample-tests/switches' => {
+                "$TEST_DIR/switches" => {
                     'canon'  => 1,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 1,
-                    'name'   => 't/sample-tests/switches',
+                    'name'   => "$TEST_DIR/switches",
                     'wstat'  => ''
                 }
             },
@@ -659,12 +661,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         'todo_inline' => {
             'failed' => {},
             'todo'   => {
-                't/sample-tests/todo_inline' => {
+                "$TEST_DIR/todo_inline" => {
                     'canon'  => 2,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 2,
-                    'name'   => 't/sample-tests/todo_inline',
+                    'name'   => "$TEST_DIR/todo_inline",
                     'wstat'  => ''
                 }
             },
@@ -683,12 +685,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'todo_misparse' => {
             'failed' => {
-                't/sample-tests/todo_misparse' => {
+                "$TEST_DIR/todo_misparse" => {
                     'canon'  => 1,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 1,
-                    'name'   => 't/sample-tests/todo_misparse',
+                    'name'   => "$TEST_DIR/todo_misparse",
                     'wstat'  => ''
                 }
             },
@@ -708,12 +710,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'too_many' => {
             'failed' => {
-                't/sample-tests/too_many' => {
+                "$TEST_DIR/too_many" => {
                     'canon'  => '4-7',
                     'estat'  => 4,
                     'failed' => 4,
                     'max'    => 3,
-                    'name'   => 't/sample-tests/too_many',
+                    'name'   => "$TEST_DIR/too_many",
                     'wstat'  => '1024'
                 }
             },
@@ -733,12 +735,12 @@ local $ENV{HARNESS_PERL_SWITCHES};
         },
         'vms_nit' => {
             'failed' => {
-                't/sample-tests/vms_nit' => {
+                "$TEST_DIR/vms_nit" => {
                     'canon'  => 1,
                     'estat'  => '',
                     'failed' => 1,
                     'max'    => 2,
-                    'name'   => 't/sample-tests/vms_nit',
+                    'name'   => "$TEST_DIR/vms_nit",
                     'wstat'  => ''
                 }
             },
@@ -785,13 +787,13 @@ local $ENV{HARNESS_PERL_SWITCHES};
         return $hash unless $^O eq 'VMS';
 
         while ( my ( $file, $want ) = each %$hash ) {
-            for ( qw( estat wstat ) ) {
+            for (qw( estat wstat )) {
                 if ( exists $want->{$_} ) {
                     $want->{$_} = $want->{$_} ? 1 : 0;
                 }
             }
         }
-        return $hash
+        return $hash;
     }
 
     {
diff --git a/ext/Test/Harness/t/glob-to-regexp.t b/ext/Test/Harness/t/glob-to-regexp.t
new file mode 100644 (file)
index 0000000..493daab
--- /dev/null
@@ -0,0 +1,44 @@
+#!/usr/bin/perl -w
+
+use strict;
+
+use Test::More;
+
+require TAP::Parser::Scheduler;
+
+my @tests;
+while (<DATA>) {
+    my ( $glob, $pattern, $name ) = /^(\S+)\t+(\S+)(?:\t+(.*))?$/;
+    die "'$_'" unless $pattern;
+    push @tests, [ $glob, $pattern, $name ];
+}
+
+plan tests => scalar @tests;
+
+foreach (@tests) {
+    my ( $glob, $pattern, $name ) = @$_;
+    is( TAP::Parser::Scheduler->_glob_to_regexp($glob), $pattern,
+        defined $name ? "$glob  -- $name" : $glob
+    );
+}
+__DATA__
+Pie                    Pie
+*.t                    [^/]*\.t
+**.t                   .*?\.t
+A?B                    A[^/]B
+*/*.t                  [^/]*\/[^/]*\.t
+A,B                    A\,B                            , outside {} not special
+{A,B}                  (?:A|B)
+A{B}C                  A(?:B)C
+A{B,C}D                        A(?:B|C)D
+A{B,C,D}E{F,G,H}I,J    A(?:B|C|D)E(?:F|G|H)I\,J
+{Perl,Rules}           (?:Perl|Rules)
+A}B                    A\}B                            Bare } corner case
+A{B,C}D}E              A(?:B|C)D\}E
+},A{B,C}D},E           \}\,A(?:B|C)D\}\,E
+{A{1,2},D{3,4}}                (?:A(?:1|2)|D(?:3|4))
+{A,{B,C},D}            (?:A|(?:B|C)|D)
+A{B,C\}D,E\,F}G                A(?:B|C\}D|E\,F)G
+A\\B                   A\\B
+A(B)C                  A\(B\)C
+1{A(B)C,D|E}2          1(?:A\(B\)C|D\|E)2
diff --git a/ext/Test/Harness/t/harness-subclass.t b/ext/Test/Harness/t/harness-subclass.t
new file mode 100644 (file)
index 0000000..0039b4d
--- /dev/null
@@ -0,0 +1,75 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = ( '../lib', '../ext/Test/Harness/t/lib' );
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use TAP::Harness;
+use Test::More tests => 13;
+
+my %class_map = (
+    aggregator_class  => 'My::TAP::Parser::Aggregator',
+    formatter_class   => 'My::TAP::Formatter::Console',
+    multiplexer_class => 'My::TAP::Parser::Multiplexer',
+    parser_class      => 'My::TAP::Parser',
+    scheduler_class   => 'My::TAP::Parser::Scheduler',
+);
+
+my %loaded = ();
+
+# Synthesize our subclasses
+for my $class ( values %class_map ) {
+    ( my $base_class = $class ) =~ s/^My:://;
+    use_ok($base_class);
+
+    no strict 'refs';
+    @{"${class}::ISA"} = ($base_class);
+    *{"${class}::new"} = sub {
+        my $pkg = shift;
+        $loaded{$pkg} = 1;
+
+        # Can't use SUPER outside a package
+        return $base_class->can('new')->( $pkg, @_ );
+    };
+}
+
+{
+    ok my $harness = TAP::Harness->new( { %class_map, verbosity => -9 } ),
+      'created harness';
+    isa_ok $harness, 'TAP::Harness';
+
+    # Test dynamic loading
+    ok !$INC{'NOP.pm'}, 'NOP not loaded';
+    ok my $nop = $harness->_construct('NOP'), 'loaded and created';
+    isa_ok $nop, 'NOP';
+    ok $INC{'NOP.pm'}, 'NOP loaded';
+
+    my $aggregate = $harness->runtests(
+        File::Spec->catfile(
+            (   $ENV{PERL_CORE}
+                ? ( File::Spec->updir, 'ext', 'Test', 'Harness' )
+                : ()
+            ),
+            't',
+            'sample-tests',
+            'simple'
+        )
+    );
+
+    isa_ok $aggregate, 'My::TAP::Parser::Aggregator';
+
+    is_deeply \%loaded,
+      { 'My::TAP::Parser::Aggregator' => 1,
+        'My::TAP::Formatter::Console' => 1,
+        'My::TAP::Parser'             => 1,
+        'My::TAP::Parser::Scheduler'  => 1,
+      },
+      'loaded our classes';
+}
index 32b9162..f80be21 100644 (file)
@@ -19,8 +19,10 @@ use TAP::Harness;
 
 my $HARNESS = 'TAP::Harness';
 
-my $source_tests = $ENV{PERL_CORE} ? '../ext/Test/Harness/t/source_tests' : 't/source_tests';
-my $sample_tests = $ENV{PERL_CORE} ? '../ext/Test/Harness/t/sample-tests' : 't/sample-tests';
+my $source_tests
+  = $ENV{PERL_CORE} ? '../ext/Test/Harness/t/source_tests' : 't/source_tests';
+my $sample_tests
+  = $ENV{PERL_CORE} ? '../ext/Test/Harness/t/sample-tests' : 't/sample-tests';
 
 plan tests => 113;
 
@@ -523,7 +525,9 @@ SKIP: {
     eval {
         _runtests(
             $harness,
-            $ENV{PERL_CORE} ? '../ext/Test/Harness/t/data/catme.1' : 't/data/catme.1'
+            $ENV{PERL_CORE}
+            ? '../ext/Test/Harness/t/data/catme.1'
+            : 't/data/catme.1'
         );
     };
 
@@ -810,7 +814,13 @@ sub _runtests {
 
     # coverage tests for the basically untested T::H::_open_spool
 
-    my @spool = ( ( $ENV{PERL_CORE} ? (File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ), ( 't', 'spool' ) );
+    my @spool = (
+        (   $ENV{PERL_CORE}
+            ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+            : ()
+        ),
+        ( 't', 'spool' )
+    );
     $ENV{PERL_TEST_HARNESS_DUMP_TAP} = File::Spec->catfile(@spool);
 
 # now given that we're going to be writing stuff to the file system, make sure we have
@@ -849,7 +859,8 @@ sub _runtests {
         {   name   => 'all the same',
             input  => [ 'foo.t', 'bar.t', 'fletz.t' ],
             output => [
-                [ 'foo.t', 'foo' ], [ 'bar.t', 'bar' ], [ 'fletz.t', 'fletz' ]
+                [ 'foo.t', 'foo' ], [ 'bar.t', 'bar' ],
+                [ 'fletz.t', 'fletz' ]
             ],
         },
         {   name   => 'all the same, already cooked',
index e4df510..4771a58 100644 (file)
@@ -42,8 +42,13 @@ my @schedule = (
             command => [
                 $^X,
                 File::Spec->catfile(
-                    ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-                    't', 'sample-tests', 'out_err_mix'
+                    (   $ENV{PERL_CORE}
+                        ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+                        : ()
+                    ),
+                    't',
+                    'sample-tests',
+                    'out_err_mix'
                 )
             ],
             merge    => 1,
diff --git a/ext/Test/Harness/t/lib/NOP.pm b/ext/Test/Harness/t/lib/NOP.pm
new file mode 100644 (file)
index 0000000..6de1dbf
--- /dev/null
@@ -0,0 +1,7 @@
+package NOP;
+
+# Do nothing much
+
+sub new { bless {}, shift }
+
+1;
index eccbb0e..dc89cd9 100644 (file)
@@ -56,8 +56,15 @@ my @schedule = (
             return [
                 TAP::Parser->new(
                     {   source => File::Spec->catfile(
-                            ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-                           't', 'sample-tests', 'simple'
+                            (   $ENV{PERL_CORE}
+                                ? ( File::Spec->updir(), 'ext', 'Test',
+                                    'Harness'
+                                  )
+                                : ()
+                            ),
+                            't',
+                            'sample-tests',
+                            'simple'
                         ),
                     }
                 ),
@@ -76,8 +83,15 @@ my @schedule = (
             return map {
                 [   TAP::Parser->new(
                         {   source => File::Spec->catfile(
-                                ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-                                't', 'sample-tests', 'simple'
+                                (   $ENV{PERL_CORE}
+                                    ? ( File::Spec->updir(), 'ext', 'Test',
+                                        'Harness'
+                                      )
+                                    : ()
+                                ),
+                                't',
+                                'sample-tests',
+                                'simple'
                             ),
                         }
                     ),
@@ -116,8 +130,15 @@ my @schedule = (
               ( map {
                     [   TAP::Parser->new(
                             {   source => File::Spec->catfile(
-                                    ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-                                    't', 'sample-tests', 'simple'
+                                    (   $ENV{PERL_CORE}
+                                        ? ( File::Spec->updir(), 'ext',
+                                            'Test', 'Harness'
+                                          )
+                                        : ()
+                                    ),
+                                    't',
+                                    'sample-tests',
+                                    'simple'
                                 ),
                             }
                         ),
index 72a2adb..9aa42a4 100755 (executable)
@@ -57,8 +57,8 @@ my $mod = 'TAP::Parser::Iterator::Process';
             stdout    => $capture,
         }
     );
-    $harness->runtests(
-        ( $ENV{PERL_CORE} ? '../ext/Test/Harness/' : '' ) . 't/sample-tests/simple' );
+    $harness->runtests( ( $ENV{PERL_CORE} ? '../ext/Test/Harness/' : '' )
+        . 't/sample-tests/simple' );
     my @output = tied($$capture)->dump;
     is pop @output, "Result: PASS\n", 'status OK';
     pop @output;    # get rid of summary line
index b52f2c5..df80cd1 100755 (executable)
@@ -605,8 +605,13 @@ END_TAP
 
     my $parser = TAP::Parser->new(
         {   source => File::Spec->catfile(
-                ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-                't', 'sample-tests', 'simple'
+                (   $ENV{PERL_CORE}
+                    ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+                    : ()
+                ),
+                't',
+                'sample-tests',
+                'simple'
             ),
         }
     );
index abebf69..a233906 100644 (file)
@@ -28,8 +28,13 @@ my @expect = (
 );
 
 my $source = File::Spec->catfile(
-    ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-    't', 'sample-tests', 'delayed'
+    (   $ENV{PERL_CORE}
+        ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+        : ()
+    ),
+    't',
+    'sample-tests',
+    'delayed'
 );
 
 for my $chunk_size ( 1, 4, 65536 ) {
index c808870..06c37f6 100644 (file)
@@ -164,11 +164,11 @@ BEGIN {    # START PLAN
             expect => {},
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
-                    'one',
-                    'two',
-                    'three'
+                    'one', 'two', 'three'
                 ]
             ],
         },
@@ -201,7 +201,7 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    { verbosity => 0, show_count => 1 },
                     'TAP::Harness',
                     'one', 'two',
                     'three'
@@ -219,7 +219,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -237,8 +238,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   color     => 1,
-                        verbosity => 0
+                    {   color      => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -257,7 +259,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   directives => 1,
-                        verbosity  => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -274,8 +277,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   exec      => [1],
-                        verbosity => 0
+                    {   exec       => [1],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -292,8 +296,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   failures  => 1,
-                        verbosity => 0
+                    {   failures   => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -312,7 +317,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   formatter_class => 'TAP::Harness',
-                        verbosity       => 0
+                        verbosity       => 0,
+                        show_count      => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -331,7 +337,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( [qw( four five six )] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -349,7 +356,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( ['lib'] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -366,8 +374,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   merge     => 1,
-                        verbosity => 0
+                    {   merge      => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -384,8 +393,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   errors    => 1,
-                        verbosity => 0
+                    {   errors     => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -402,7 +412,8 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -1
+                    {   verbosity  => -1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -419,7 +430,8 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -2
+                    {   verbosity  => -2,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -436,7 +448,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     'one', 'two', 'three'
                 ]
@@ -452,7 +466,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     'three', 'two', 'one'
                 ]
@@ -469,7 +485,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     'xxxone', 'xxxtwo',
                     'xxxthree'
@@ -486,8 +504,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   switches  => ['-T'],
-                        verbosity => 0
+                    {   switches   => ['-T'],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -504,8 +523,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   switches  => ['-t'],
-                        verbosity => 0
+                    {   switches   => ['-t'],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -522,7 +542,8 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 1
+                    {   verbosity  => 1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -539,8 +560,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   switches  => ['-W'],
-                        verbosity => 0
+                    {   switches   => ['-W'],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -557,8 +579,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   switches  => ['-w'],
-                        verbosity => 0
+                    {   switches   => ['-w'],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     'one', 'two', 'three'
@@ -577,7 +600,8 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 1
+                    {   verbosity  => 1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -595,7 +619,8 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 1
+                    {   verbosity  => 1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -611,8 +636,9 @@ BEGIN {    # START PLAN
             expect => { failures => 1 },
             runlog => [
                 [   '_runtests',
-                    {   failures  => 1,
-                        verbosity => 0
+                    {   failures   => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -628,8 +654,9 @@ BEGIN {    # START PLAN
             expect => { failures => 1 },
             runlog => [
                 [   '_runtests',
-                    {   failures  => 1,
-                        verbosity => 0
+                    {   failures   => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -646,7 +673,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( ['lib'] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -663,7 +691,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( ['lib'] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -680,7 +709,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -697,7 +727,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
-                        verbosity => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -713,7 +744,9 @@ BEGIN {    # START PLAN
             expect => { shuffle => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     "xxx$dummy_test"
                 ]
@@ -728,7 +761,9 @@ BEGIN {    # START PLAN
             expect => { shuffle => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     "xxx$dummy_test"
                 ]
@@ -743,8 +778,9 @@ BEGIN {    # START PLAN
             expect => { color => 1 },
             runlog => [
                 [   '_runtests',
-                    {   color     => 1,
-                        verbosity => 0
+                    {   color      => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -760,7 +796,9 @@ BEGIN {    # START PLAN
             expect => { recurse => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -775,7 +813,9 @@ BEGIN {    # START PLAN
             expect => { recurse => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -790,7 +830,9 @@ BEGIN {    # START PLAN
             expect => { backwards => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     reverse @dummy_tests
                 ]
@@ -807,8 +849,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   errors    => 1,
-                        verbosity => 0
+                    {   errors     => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -826,8 +869,9 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    {   errors    => 1,
-                        verbosity => 0
+                    {   errors     => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -843,7 +887,8 @@ BEGIN {    # START PLAN
             expect => { quiet => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -1
+                    {   verbosity  => -1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -859,7 +904,8 @@ BEGIN {    # START PLAN
             expect => { quiet => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -1
+                    {   verbosity  => -1,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -875,7 +921,8 @@ BEGIN {    # START PLAN
             expect => { really_quiet => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -2
+                    {   verbosity  => -2,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -891,7 +938,8 @@ BEGIN {    # START PLAN
             expect => { really_quiet => 1 },
             runlog => [
                 [   '_runtests',
-                    { verbosity => -2
+                    {   verbosity  => -2,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -907,8 +955,9 @@ BEGIN {    # START PLAN
             expect => { merge => 1 },
             runlog => [
                 [   '_runtests',
-                    {   merge     => 1,
-                        verbosity => 0
+                    {   merge      => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -924,8 +973,9 @@ BEGIN {    # START PLAN
             expect => { merge => 1 },
             runlog => [
                 [   '_runtests',
-                    {   merge     => 1,
-                        verbosity => 0
+                    {   merge      => 1,
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -942,7 +992,8 @@ BEGIN {    # START PLAN
             runlog => [
                 [   '_runtests',
                     {   directives => 1,
-                        verbosity  => 0
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -958,7 +1009,11 @@ BEGIN {    # START PLAN
             switches => [ '--exec', '-s', $dummy_test ],
             expect => { exec => '-s' },
             runlog => [
-                [   '_runtests', { exec => ['-s'], verbosity => 0 },
+                [   '_runtests',
+                    {   exec       => ['-s'],
+                        verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -974,8 +1029,9 @@ BEGIN {    # START PLAN
             expect => { exec => '/foo/bar/perl -Ilib' },
             runlog => [
                 [   '_runtests',
-                    {   exec      => [qw(/foo/bar/perl -Ilib)],
-                        verbosity => 0
+                    {   exec       => [qw(/foo/bar/perl -Ilib)],
+                        verbosity  => 0,
+                        show_count => 1,
                     },
                     'TAP::Harness',
                     $dummy_test
@@ -992,7 +1048,10 @@ BEGIN {    # START PLAN
             },
             runlog => [
                 [   '_runtests',
-                    { exec => [], verbosity => 0 },
+                    {   exec       => [],
+                        verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -1016,7 +1075,9 @@ BEGIN {    # START PLAN
             plan   => 1,
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -1043,7 +1104,9 @@ BEGIN {    # START PLAN
             plan   => 1,
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -1066,7 +1129,9 @@ BEGIN {    # START PLAN
             plan   => 1,
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
@@ -1089,7 +1154,9 @@ BEGIN {    # START PLAN
             plan   => 1,
             runlog => [
                 [   '_runtests',
-                    { verbosity => 0 },
+                    {   verbosity  => 0,
+                        show_count => 1,
+                    },
                     'TAP::Harness',
                     $dummy_test
                 ]
index df4cbbb..ec2d618 100644 (file)
@@ -20,7 +20,12 @@ my $prove = App::Prove->new;
 
 $prove->add_rc_file(
     File::Spec->catfile(
-        ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ), 't', 'data', 'proverc'
+        (   $ENV{PERL_CORE}
+            ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+            : ()
+        ),
+        't', 'data',
+        'proverc'
     )
 );
 
index 7db0197..aafe8a5 100644 (file)
@@ -19,29 +19,50 @@ my @SCHEDULE;
 
 BEGIN {
 
-    my $sample_test = File::Spec->catfile(
-        ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ), 
-        't', 'sample-tests', 'simple'
+    # to add a new test to proverun, just list the name of the file in
+    # t/sample-tests and a name for the test.  The rest is handled
+    # automatically.
+    my @tests = (
+        {   file => 'simple',
+            name => 'Create empty',
+        },
+        {   file => 'todo_inline',
+            name => 'Passing TODO',
+        },
     );
-
+    foreach my $test (@tests) {
+        
+        # let's fully expand that filename
+        $test->{file} = File::Spec->catfile(
+            (   $ENV{PERL_CORE}
+                ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+                : ()
+            ),
+            't',
+            'sample-tests',
+            $test->{file}
+        );
+    }
     @SCHEDULE = (
-        {   name   => 'Create empty',
-            args   => [$sample_test],
-            expect => [
-                [   'new',
-                    'TAP::Parser::Iterator::Process',
-                    {   merge   => undef,
-                        command => [
-                            'PERL',
-                            $sample_test
-                        ],
-                        setup    => \'CODE',
-                        teardown => \'CODE',
-
-                    }
+        map {
+            {   name   => $_->{name},
+                args   => [ $_->{file} ],
+                expect => [
+                    [   'new',
+                        'TAP::Parser::Iterator::Process',
+                        {   merge   => undef,
+                            command => [
+                                'PERL',
+                                $_->{file},
+                            ],
+                            setup    => \'CODE',
+                            teardown => \'CODE',
+
+                        }
+                    ]
                 ]
-            ]
-        },
+            }
+          } @tests
     );
 
     plan tests => @SCHEDULE * 3;
@@ -141,7 +162,7 @@ for my $test (@SCHEDULE) {
     # Why does this make the output from the test spew out of
     # our STDOUT?
     ok eval { $app->run }, 'run returned true';
-    ok !$@, 'no errors';
+    ok !$@, 'no errors' or diag $@;
 
     my @log = get_log();
 
index 8f93e4e..cd41ada 100644 (file)
@@ -30,8 +30,12 @@ my $IsWin32 = $^O eq 'MSWin32';
 
 my $SAMPLE_TESTS = File::Spec->catdir(
     File::Spec->curdir,
-    ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-    't', 'sample-tests'
+    (   $ENV{PERL_CORE}
+        ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+        : ()
+    ),
+    't',
+    'sample-tests'
 );
 
 my %deprecated = map { $_ => 1 } qw(
index 94f667f..eb79d58 100644 (file)
@@ -1,11 +1,5 @@
 # Used to test Process.pm
 
-BEGIN {
-    if ( $ENV{PERL_CORE} ) {
-        unshift @INC, '../lib';
-    }
-}
-
 use Time::HiRes qw(sleep);
 
 my $delay = 0.01;
index 223b535..d1be667 100644 (file)
@@ -1,14 +1,5 @@
 #!/usr/bin/perl -Tw
 
-BEGIN {
-    if ( $ENV{PERL_CORE} ) {
-        unshift @INC, '../lib';
-    }
-    else {
-        unshift @INC, 't/lib';
-    }
-}
-
 use Test::More tests => 1;
 
 ok( grep( /examples/, @INC ) );
index 2f8ca38..ce17484 100644 (file)
@@ -1,8 +1,3 @@
-BEGIN {
-    if ( $ENV{PERL_CORE} ) {
-        unshift @INC, '../lib';
-    }
-}
 use Test::More 'no_plan';
 diag 'comments';
 ok 1;
index 99d81f9..b02475c 100644 (file)
@@ -22,8 +22,13 @@ use TAP::Parser::Source::Perl;
 
 my $parser = EmptyParser->new;
 my $test   = File::Spec->catfile(
-    ( $ENV{PERL_CORE} ?  ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-    't', 'source_tests', 'source'
+    (   $ENV{PERL_CORE}
+        ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+        : ()
+    ),
+    't',
+    'source_tests',
+    'source'
 );
 
 my $perl = $^X;
index e6bfb7c..2808637 100644 (file)
@@ -13,6 +13,7 @@ BEGIN {
 use strict;
 use Test::More;
 use App::Prove::State;
+use App::Prove::State::Result;
 
 sub mn {
     my $pfx = $ENV{PERL_CORE} ? '../ext/Test/Harness/' : '';
@@ -150,6 +151,13 @@ my @schedule = (
             't/source.t',
         ],
     },
+    {   options        => 'fresh',
+        get_tests_args => [],
+        expect         => [
+            't/compat/env.t',
+            't/compat/failure.t',
+        ],
+    },
 );
 
 plan tests => @schedule * 2;
@@ -175,78 +183,80 @@ for my $test (@schedule) {
 }
 
 sub get_state {
-    return {
-        'generation' => '51',
-        'tests'      => {
-            mn('t/compat/failure.t') => {
-                'last_result'    => '0',
-                'last_run_time'  => '1196371471.57738',
-                'last_pass_time' => '1196371471.57738',
-                'total_passes'   => '48',
-                'seq'            => '1549',
-                'gen'            => '51',
-                'elapsed'        => 0.1230,
-                'last_todo'      => '1',
-                'mtime'          => 1196285623,
-            },
-            mn('t/yamlish-writer.t') => {
-                'last_result'    => '0',
-                'last_run_time'  => '1196371480.5761',
-                'last_pass_time' => '1196371480.5761',
-                'last_fail_time' => '1196368609',
-                'total_passes'   => '41',
-                'seq'            => '1578',
-                'gen'            => '49',
-                'elapsed'        => 12.2983,
-                'last_todo'      => '0',
-                'mtime'          => 1196285400,
-            },
-            mn('t/compat/env.t') => {
-                'last_result'    => '0',
-                'last_run_time'  => '1196371471.42967',
-                'last_pass_time' => '1196371471.42967',
-                'last_fail_time' => '1196368608',
-                'total_passes'   => '48',
-                'seq'            => '1548',
-                'gen'            => '52',
-                'elapsed'        => 3.1290,
-                'last_todo'      => '0',
-                'mtime'          => 1196285739,
-            },
-            mn('t/compat/version.t') => {
-                'last_result'    => '2',
-                'last_run_time'  => '1196371472.96476',
-                'last_pass_time' => '1196371472.96476',
-                'last_fail_time' => '1196368609',
-                'total_passes'   => '47',
-                'seq'            => '1555',
-                'gen'            => '51',
-                'elapsed'        => 0.2363,
-                'last_todo'      => '4',
-                'mtime'          => 1196285239,
-            },
-            mn('t/compat/inc_taint.t') => {
-                'last_result'    => '3',
-                'last_run_time'  => '1196371471.89682',
-                'last_pass_time' => '1196371471.89682',
-                'total_passes'   => '47',
-                'seq'            => '1551',
-                'gen'            => '51',
-                'elapsed'        => 1.6938,
-                'last_todo'      => '0',
-                'mtime'          => 1196185639,
-            },
-            mn('t/source.t') => {
-                'last_result'    => '0',
-                'last_run_time'  => '1196371479.72508',
-                'last_pass_time' => '1196371479.72508',
-                'total_passes'   => '41',
-                'seq'            => '1570',
-                'gen'            => '51',
-                'elapsed'        => 0.0143,
-                'last_todo'      => '0',
-                'mtime'          => 1186285639,
-            },
+    return App::Prove::State::Result->new(
+        {   generation    => 51,
+            last_run_time => 1196285439,
+            tests         => {
+                mn('t/compat/failure.t') => {
+                    last_result    => 0,
+                    last_run_time  => 1196371471.57738,
+                    last_pass_time => 1196371471.57738,
+                    total_passes   => 48,
+                    seq            => 1549,
+                    gen            => 51,
+                    elapsed        => 0.1230,
+                    last_todo      => 1,
+                    mtime          => 1196285623,
+                },
+                mn('t/yamlish-writer.t') => {
+                    last_result    => 0,
+                    last_run_time  => 1196371480.5761,
+                    last_pass_time => 1196371480.5761,
+                    last_fail_time => 1196368609,
+                    total_passes   => 41,
+                    seq            => 1578,
+                    gen            => 49,
+                    elapsed        => 12.2983,
+                    last_todo      => 0,
+                    mtime          => 1196285400,
+                },
+                mn('t/compat/env.t') => {
+                    last_result    => 0,
+                    last_run_time  => 1196371471.42967,
+                    last_pass_time => 1196371471.42967,
+                    last_fail_time => 1196368608,
+                    total_passes   => 48,
+                    seq            => 1548,
+                    gen            => 52,
+                    elapsed        => 3.1290,
+                    last_todo      => 0,
+                    mtime          => 1196285739,
+                },
+                mn('t/compat/version.t') => {
+                    last_result    => 2,
+                    last_run_time  => 1196371472.96476,
+                    last_pass_time => 1196371472.96476,
+                    last_fail_time => 1196368609,
+                    total_passes   => 47,
+                    seq            => 1555,
+                    gen            => 51,
+                    elapsed        => 0.2363,
+                    last_todo      => 4,
+                    mtime          => 1196285239,
+                },
+                mn('t/compat/inc_taint.t') => {
+                    last_result    => 3,
+                    last_run_time  => 1196371471.89682,
+                    last_pass_time => 1196371471.89682,
+                    total_passes   => 47,
+                    seq            => 1551,
+                    gen            => 51,
+                    elapsed        => 1.6938,
+                    last_todo      => 0,
+                    mtime          => 1196185639,
+                },
+                mn('t/source.t') => {
+                    last_result    => 0,
+                    last_run_time  => 1196371479.72508,
+                    last_pass_time => 1196371479.72508,
+                    total_passes   => 41,
+                    seq            => 1570,
+                    gen            => 51,
+                    elapsed        => 0.0143,
+                    last_todo      => 0,
+                    mtime          => 1186285639,
+                },
+            }
         }
-    };
+    );
 }
diff --git a/ext/Test/Harness/t/state_results.t b/ext/Test/Harness/t/state_results.t
new file mode 100644 (file)
index 0000000..db532c9
--- /dev/null
@@ -0,0 +1,154 @@
+#!/usr/bin/perl -w
+
+BEGIN {
+    if ( $ENV{PERL_CORE} ) {
+        chdir 't';
+        @INC = '../lib';
+    }
+    else {
+        unshift @INC, 't/lib';
+    }
+}
+
+use strict;
+use Test::More tests => 25;
+use App::Prove::State;
+
+my $test_suite_data = test_suite_data();
+
+#
+# Test test suite results
+#
+
+can_ok 'App::Prove::State::Result', 'new';
+isa_ok my $result = App::Prove::State::Result->new($test_suite_data),
+  'App::Prove::State::Result', '... and the object it returns';
+
+ok $result, 'state_version';
+ok defined $result->state_version, '... and it should be defined';
+
+can_ok $result, 'generation';
+is $result->generation, $test_suite_data->{generation},
+  '... and it should return the correct generation';
+
+can_ok $result, 'num_tests';
+is $result->num_tests, scalar keys %{ $test_suite_data->{tests} },
+  '... and it should return the number of tests run';
+
+can_ok $result, 'raw';
+is_deeply $result->raw, $test_suite_data,
+  '... and it should return the raw, unblessed data';
+
+#
+# Check individual tests.
+#
+
+can_ok $result, 'tests';
+
+can_ok $result, 'test';
+eval { $result->test };
+my $error = $@;
+like $error, qr/^\Qtest() requires a test name/,
+  '... and it should croak() if a test name is not supplied';
+
+my $name = 't/compat/failure.t';
+ok my $test = $result->test('t/compat/failure.t'),
+  'result() should succeed if the test name is found';
+isa_ok $test, 'App::Prove::State::Result::Test',
+  '... and the object it returns';
+
+can_ok $test, 'name';
+is $test->name, $name, '... and it should return the test name';
+
+can_ok $test, 'last_pass_time';
+like $test->last_pass_time, qr/^\d+\.\d+$/,
+  '... and it should return a numeric value';
+
+can_ok $test, 'last_fail_time';
+ok !defined $test->last_fail_time,
+  '... and it should return undef if the test has never failed';
+
+can_ok $result, 'remove';
+ok $result->remove($name), '... and calling it should succeed';
+
+ok $test = $result->test($name),
+  '... and fetching the removed test should suceed';
+ok !defined $test->last_pass_time, '... and it should have clean values';
+
+sub test_suite_data {
+    return {
+        'version'    => App::Prove::State::Result->state_version,
+        'generation' => '51',
+        'tests'      => {
+            't/compat/failure.t' => {
+                'last_result'    => '0',
+                'last_run_time'  => '1196371471.57738',
+                'last_pass_time' => '1196371471.57738',
+                'total_passes'   => '48',
+                'seq'            => '1549',
+                'gen'            => '51',
+                'elapsed'        => 0.1230,
+                'last_todo'      => '1',
+                'mtime'          => 1196285623,
+            },
+            't/yamlish-writer.t' => {
+                'last_result'    => '0',
+                'last_run_time'  => '1196371480.5761',
+                'last_pass_time' => '1196371480.5761',
+                'last_fail_time' => '1196368609',
+                'total_passes'   => '41',
+                'seq'            => '1578',
+                'gen'            => '49',
+                'elapsed'        => 12.2983,
+                'last_todo'      => '0',
+                'mtime'          => 1196285400,
+            },
+            't/compat/env.t' => {
+                'last_result'    => '0',
+                'last_run_time'  => '1196371471.42967',
+                'last_pass_time' => '1196371471.42967',
+                'last_fail_time' => '1196368608',
+                'total_passes'   => '48',
+                'seq'            => '1548',
+                'gen'            => '52',
+                'elapsed'        => 3.1290,
+                'last_todo'      => '0',
+                'mtime'          => 1196285739,
+            },
+            't/compat/version.t' => {
+                'last_result'    => '2',
+                'last_run_time'  => '1196371472.96476',
+                'last_pass_time' => '1196371472.96476',
+                'last_fail_time' => '1196368609',
+                'total_passes'   => '47',
+                'seq'            => '1555',
+                'gen'            => '51',
+                'elapsed'        => 0.2363,
+                'last_todo'      => '4',
+                'mtime'          => 1196285239,
+            },
+            't/compat/inc_taint.t' => {
+                'last_result'    => '3',
+                'last_run_time'  => '1196371471.89682',
+                'last_pass_time' => '1196371471.89682',
+                'total_passes'   => '47',
+                'seq'            => '1551',
+                'gen'            => '51',
+                'elapsed'        => 1.6938,
+                'last_todo'      => '0',
+                'mtime'          => 1196185639,
+            },
+            't/source.t' => {
+                'last_result'    => '0',
+                'last_run_time'  => '1196371479.72508',
+                'last_pass_time' => '1196371479.72508',
+                'total_passes'   => '41',
+                'seq'            => '1570',
+                'gen'            => '51',
+                'elapsed'        => 0.0143,
+                'last_todo'      => '0',
+                'mtime'          => 1186285639,
+            },
+        }
+    };
+}
index 0c69f8a..7291992 100644 (file)
@@ -14,8 +14,13 @@ use TAP::Harness;
 use App::Prove;
 
 my $test = File::Spec->catfile(
-    ( $ENV{PERL_CORE} ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' ) : () ),
-    't', 'sample-tests', 'echo'
+    (   $ENV{PERL_CORE}
+        ? ( File::Spec->updir(), 'ext', 'Test', 'Harness' )
+        : ()
+    ),
+    't',
+    'sample-tests',
+    'echo'
 );
 
 diag( "\n\n", bigness( join ' ', @ARGV ), "\n\n" ) if @ARGV;