Win32 parallel testing

.travis.yml

@@ -0,0 +1,41 @@
+language: perl
+notifications:
+  on_success: never
+  on_failure: always
+#  irc: "irc.perl.org#makemaker"
+  email: false
+sudo: false
+perl:
+  - "blead"
+  - "5.6.2"
+  - "5.8.1"
+  - "5.8.5"
+  - "5.8.7"
+  - "5.8.8"
+  - "5.8.9"
+  - "5.10.0"
+  - "5.10.1"
+  - "5.12.0"
+  - "5.12"
+  - "5.14.0"
+  - "5.14"
+  - "5.16.0"
+  - "5.16"
+  - "5.18.0"
+  - "5.18"
+  - "5.20"
+matrix:
+  allow_failures:
+    - perl: "blead"
+    - perl: "5.6.2"
+before_install:
+  - git clone git://github.com/haarg/perl-travis-helper ~/perl-travis-helper
+  - source ~/perl-travis-helper/init
+  - build-perl
+  - perl -V
+install:
+  - true
+script:
+  - perl Makefile.PL
+  - make test
+  - make disttest

MANIFEST

@@ -37,6 +37,8 @@ lib/TAP/Parser/Grammar.pm
 lib/TAP/Parser/Iterator.pm
 lib/TAP/Parser/Iterator/Array.pm
 lib/TAP/Parser/Iterator/Process.pm
+lib/TAP/Parser/Iterator/Process/Unix.pm
+lib/TAP/Parser/Iterator/Process/Windows.pm
 lib/TAP/Parser/Iterator/Stream.pm
 lib/TAP/Parser/IteratorFactory.pm
 lib/TAP/Parser/Multiplexer.pm

appveyor.yml

@@ -0,0 +1,15 @@
+version: 1.0.{build}
+skip_tags: true
+clone_depth: 1
+init:
+  - git config --global core.autocrlf input
+# Mingw and Cygwin now builtin: http://www.appveyor.com/updates/2015/05/30
+#os: MinGW
+
+install:
+  - perl -V
+  - C:\MinGW\bin\mingw32-make -v
+  - echo %PATH%
+build_script:
+#do not let gmake find sh.exe (usually part of git for windows) in %PATH%
+- set PATH=C:\windows\system32;C:\Perl\site\bin;C:\Perl\bin;C:\windows;C:\MinGW\bin; && set ACTIVEPERL_CONFIG_DISABLE=1 && perl Makefile.PL MAKE=gmake && mingw32-make test

lib/TAP/Formatter/Base.pm

@@ -396,9 +396,7 @@ sub _summary_test_header {
 }
 
 sub _output {
-    my $self = shift;
-
-    print { $self->stdout } @_;
+    print { shift->stdout } @_;
 }
 
 sub _failure_output {

lib/TAP/Formatter/Console/Session.pm

@@ -128,17 +128,17 @@ sub _closures {
                 my $planned = $parser->tests_planned || '?';
                 $plan = "/$planned ";
             }
-            $output = $formatter->_get_output_method($parser);
 
             if ( $show_count and $is_test ) {
-                my $number = $result->number;
                 my $now    = CORE::time;
 
                 # 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 ) {
+                    my $number = $result->number;
+                    $output = $formatter->_get_output_method($parser);
                     $formatter->$output("\r$pretty$number$plan");
                     $last_status_printed = $now;
                 }

lib/TAP/Harness.pm

@@ -2,7 +2,6 @@ package TAP::Harness;
 
 use strict;
 use warnings;
-use Carp;
 
 use File::Spec;
 use File::Path;
@@ -87,7 +86,7 @@ BEGIN {
         trap              => sub { shift; shift },
     );
 
-    for my $method ( sort keys %VALIDATION_FOR ) {
+    for my $method ( keys %VALIDATION_FOR ) {
         no strict 'refs';
         if ( $method eq 'lib' || $method eq 'switches' ) {
             *{$method} = sub {
@@ -432,7 +431,7 @@ Any keys for which the value is C<undef> will be ignored.
         $self->SUPER::_initialize( $arg_for, \@legal_callback );
         my %arg_for = %$arg_for;    # force a shallow copy
 
-        for my $name ( sort keys %VALIDATION_FOR ) {
+        for my $name ( keys %VALIDATION_FOR ) {
             my $property = delete $arg_for{$name};
             if ( defined $property ) {
                 my $validate = $VALIDATION_FOR{$name};
@@ -475,8 +474,8 @@ Any keys for which the value is C<undef> will be ignored.
             );
         }
 
-        if ( my @props = sort keys %arg_for ) {
-            $self->_croak("Unknown arguments to TAP::Harness::new (@props)");
+        if ( my @props = keys %arg_for ) {
+            $self->_croak('Unknown arguments to TAP::Harness::new ('.join(' ',sort @props).')');
         }
 
         return $self;

lib/TAP/Object.pm

@@ -50,9 +50,7 @@ L</_initialize> method.  Returns a new object.
 =cut
 
 sub new {
-    my $class = shift;
-    my $self = bless {}, $class;
-    return $self->_initialize(@_);
+    return bless({}, shift)->_initialize(@_);
 }
 
 =head2 Instance Methods
@@ -84,7 +82,7 @@ May also be called as a I<class> method.
 =cut
 
 sub _croak {
-    my $proto = shift;
+    shift;
     require Carp;
     Carp::croak(@_);
     return;
@@ -103,7 +101,7 @@ May also be called as a I<class> method.
 =cut
 
 sub _confess {
-    my $proto = shift;
+    shift;
     require Carp;
     Carp::confess(@_);
     return;

lib/TAP/Parser.pm

@@ -15,8 +15,6 @@ use TAP::Parser::SourceHandler::File       ();
 use TAP::Parser::SourceHandler::RawTAP     ();
 use TAP::Parser::SourceHandler::Handle     ();
 
-use Carp qw( confess );
-
 use base 'TAP::Base';
 
 =encoding utf8
@@ -932,7 +930,7 @@ sub pragma {
 
     return $self->{pragma}->{$pragma} unless @_;
 
-    if ( my $state = shift ) {
+    if ( shift ) {
         $self->{pragma}->{$pragma} = 1;
     }
     else {
@@ -1038,8 +1036,7 @@ failed, any TODO tests unexpectedly succeeded, or any parse errors occurred.
 sub has_problems {
     my $self = shift;
     return
-         $self->failed
-      || $self->parse_errors
+         $self->{has_problems}
       || ( !$self->ignore_exit && ( $self->wait || $self->exit ) );
 }
 
@@ -1145,6 +1142,7 @@ sub parse_errors { @{ shift->{parse_errors} } }
 sub _add_error {
     my ( $self, $error ) = @_;
     push @{ $self->{parse_errors} } => $error;
+    $self->{has_problems} = 1;
     return $self;
 }
 
@@ -1239,8 +1237,10 @@ sub _make_state_table {
                 push @{ $self->{skipped} } => $number
                   if $test->has_skip;
 
-                push @{ $self->{ $test->is_ok ? 'passed' : 'failed' } } =>
-                  $number;
+                push @{ $self->{ $test->is_ok ?
+                                'passed'
+                                : (($self->{has_problems} = 1), 'failed') }
+                } => $number;
                 push @{
                     $self->{
                         $test->is_actual_ok
@@ -1340,9 +1340,9 @@ sub _make_state_table {
         my $st = { %state_globals, %{ $states{$name} } };
 
         # Add defaults
-        for my $next ( sort keys %{$st} ) {
+        for my $next ( keys %$st ) {
             if ( my $default = $state_defaults{$next} ) {
-                for my $def ( sort keys %{$default} ) {
+                for my $def ( keys %$default ) {
                     $st->{$next}->{$def} ||= $default->{$def};
                 }
             }
@@ -1408,7 +1408,7 @@ sub _iter {
                 }
             }
             else {
-                confess("Unhandled token type: $type\n");
+                $self->_confess("Unhandled token type: $type\n");
             }
         }
         return $token;
@@ -1520,12 +1520,13 @@ sub _finish {
     $self->is_good_plan(0) unless defined $self->is_good_plan;
 
     unless ( $self->parse_errors ) {
+        my $tests_run = $self->tests_run;
         # Optimise storage where possible
-        if ( $self->tests_run == @{$self->{passed}} ) {
-            $self->{passed} = $self->tests_run;
+        if ( $tests_run == @{$self->{passed}} ) {
+            $self->{passed} = $tests_run;
         }
-        if ( $self->tests_run == @{$self->{actual_passed}} ) {
-            $self->{actual_passed} = $self->tests_run;
+        if ( $tests_run == @{$self->{actual_passed}} ) {
+            $self->{actual_passed} = $tests_run;
         }
     }
 

lib/TAP/Parser/Aggregator.pm

@@ -198,8 +198,7 @@ Among other times it records the start time for the test run.
 =cut
 
 sub start {
-    my $self = shift;
-    $self->{start_time} = Benchmark->new;
+    shift->{start_time} = Benchmark->new;
 }
 
 =head3 C<stop>
@@ -209,8 +208,7 @@ Call C<stop> immediately after adding all test results to the aggregator.
 =cut
 
 sub stop {
-    my $self = shift;
-    $self->{end_time} = Benchmark->new;
+    shift->{end_time} = Benchmark->new;
 }
 
 =head3 C<elapsed>
@@ -224,10 +222,8 @@ afterwards.
 
 sub elapsed {
     my $self = shift;
-
-    require Carp;
-    Carp::croak
-      q{Can't call elapsed without first calling start and then stop}
+    $self->_croak(
+      q{Can't call elapsed without first calling start and then stop})
       unless defined $self->{start_time} && defined $self->{end_time};
     return timediff( $self->{end_time}, $self->{start_time} );
 }

lib/TAP/Parser/Iterator.pm

@@ -61,6 +61,8 @@ Iterate raw input without applying any fixes for quirky input syntax.
 
 =cut
 
+if ( $^O eq 'VMS' ) {
+    eval <<'END' ;
 sub next {
     my $self = shift;
     my $line = $self->next_raw;
@@ -75,6 +77,11 @@ sub next {
 
     return $line;
 }
+END
+}
+else {
+    eval 'sub next { shift->next_raw(@_) }';
+}
 
 sub next_raw {
     require Carp;
@@ -125,17 +132,8 @@ Return the C<exit> status for this iterator.
 
 =cut
 
-sub wait {
-    require Carp;
-    my $msg = Carp::longmess('abstract method called directly!');
-    $_[0]->_croak($msg);
-}
-
-sub exit {
-    require Carp;
-    my $msg = Carp::longmess('abstract method called directly!');
-    $_[0]->_croak($msg);
-}
+#can not call abstract base method, next_raw is a fatal stub
+*exit = *wait = *next_raw;
 
 1;