diff --git a/lib/TAP/Formatter/Base.pm b/lib/TAP/Formatter/Base.pm index 3d1272a9..d2ac8869 100644 --- a/lib/TAP/Formatter/Base.pm +++ b/lib/TAP/Formatter/Base.pm @@ -419,9 +419,7 @@ sub _summary_test_header { } sub _output { - my $self = shift; - - print { $self->stdout } @_; + print { shift->stdout } @_; } sub _failure_output { diff --git a/lib/TAP/Formatter/Console/Session.pm b/lib/TAP/Formatter/Console/Session.pm index 6280f857..7e8ff3da 100644 --- a/lib/TAP/Formatter/Console/Session.pm +++ b/lib/TAP/Formatter/Console/Session.pm @@ -128,10 +128,8 @@ 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. @@ -139,6 +137,8 @@ sub _closures { # $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; } diff --git a/lib/TAP/Harness.pm b/lib/TAP/Harness.pm index 90f526de..b9156d45 100644 --- a/lib/TAP/Harness.pm +++ b/lib/TAP/Harness.pm @@ -87,7 +87,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 +432,7 @@ Any keys for which the value is C 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 +475,8 @@ Any keys for which the value is C 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; diff --git a/lib/TAP/Object.pm b/lib/TAP/Object.pm index 9a739c29..c5ae4468 100644 --- a/lib/TAP/Object.pm +++ b/lib/TAP/Object.pm @@ -50,9 +50,7 @@ L 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 diff --git a/lib/TAP/Parser.pm b/lib/TAP/Parser.pm index 1f7ee863..06805f12 100644 --- a/lib/TAP/Parser.pm +++ b/lib/TAP/Parser.pm @@ -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}; } } diff --git a/lib/TAP/Parser/Iterator.pm b/lib/TAP/Parser/Iterator.pm index 87d8de93..7121339e 100644 --- a/lib/TAP/Parser/Iterator.pm +++ b/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 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; diff --git a/lib/TAP/Parser/Iterator/Process.pm b/lib/TAP/Parser/Iterator/Process.pm index c360ecdb..a69193ef 100644 --- a/lib/TAP/Parser/Iterator/Process.pm +++ b/lib/TAP/Parser/Iterator/Process.pm @@ -8,7 +8,7 @@ use IO::Handle; use base 'TAP::Parser::Iterator'; -my $IS_WIN32 = ( $^O =~ /^(MS)?Win32$/ ); +use constant IS_WIN32 => !!( $^O =~ /^(MS)?Win32$/ ); =head1 NAME @@ -91,8 +91,7 @@ Get the exit status for this iterator's process. } sub _use_open3 { - my $self = shift; - return unless $Config{d_fork} || $IS_WIN32; + return unless $Config{d_fork} || IS_WIN32; for my $module (qw( IPC::Open3 IO::Select )) { eval "use $module"; return if $@; @@ -147,7 +146,7 @@ sub _initialize { # }}} - if ($IS_WIN32) { + if (IS_WIN32) { $err = $merge ? '' : '>&STDERR'; eval { $pid = open3( @@ -340,7 +339,7 @@ sub _finish { # Sometimes we get -1 on Windows. Presumably that means status not # available. - $status = 0 if $IS_WIN32 && $status == -1; + $status = 0 if IS_WIN32 && $status == -1; $self->{wait} = $status; $self->{exit} = $self->_wait2exit($status); diff --git a/t/compat/test-harness-compat.t b/t/compat/test-harness-compat.t index 14309163..7b8f826f 100644 --- a/t/compat/test-harness-compat.t +++ b/t/compat/test-harness-compat.t @@ -150,14 +150,17 @@ if ($NoTaintSupport) { 'name' => "$TEST_DIR/too_many", 'wstat' => '1024' }, - "$TEST_DIR/vms_nit" => { - 'canon' => 1, - 'estat' => '', - 'failed' => 1, - 'max' => 2, - 'name' => "$TEST_DIR/vms_nit", - 'wstat' => '' - } + ( $^O eq 'VMS' ? + ("$TEST_DIR/vms_nit" => { + 'canon' => 1, + 'estat' => '', + 'failed' => 1, + 'max' => 2, + 'name' => "$TEST_DIR/vms_nit", + 'wstat' => '' + }) + : () + ) }, 'todo' => { "$TEST_DIR/todo_inline" => { @@ -170,12 +173,12 @@ if ($NoTaintSupport) { } }, 'totals' => { - 'bad' => ($NoTaintSupport ? 11 : 12), + 'bad' => ($NoTaintSupport ? 11 : 12)-($^O eq 'VMS' ? 0 : 1), 'bonus' => 1, 'files' => ($NoTaintSupport ? 24 : 27), - 'good' => ($NoTaintSupport ? 13 : 15), + 'good' => ($NoTaintSupport ? 13 : 15)+($^O eq 'VMS' ? 0 : 1), 'max' => ($NoTaintSupport ? 72 : 76), - 'ok' => ($NoTaintSupport ? 75 : 78), + 'ok' => ($NoTaintSupport ? 75 : 78)+($^O eq 'VMS' ? 0 : 1), 'skipped' => 2, 'sub_skipped' => 2, 'tests' => ($NoTaintSupport ? 24 : 27), @@ -739,31 +742,35 @@ if ($NoTaintSupport) { 'todo' => 0 } }, - 'vms_nit' => { - 'failed' => { - "$TEST_DIR/vms_nit" => { - 'canon' => 1, - 'estat' => '', - 'failed' => 1, - 'max' => 2, - 'name' => "$TEST_DIR/vms_nit", - 'wstat' => '' + ( $^O eq 'VMS' ? + ('vms_nit' => { + 'failed' => { + "$TEST_DIR/vms_nit" => { + 'canon' => 1, + 'estat' => '', + 'failed' => 1, + 'max' => 2, + 'name' => "$TEST_DIR/vms_nit", + 'wstat' => '' + } + }, + 'skip_if' => sub { $^O ne 'VMS' }, + 'todo' => {}, + 'totals' => { + 'bad' => 1, + 'bonus' => 0, + 'files' => 1, + 'good' => 0, + 'max' => 2, + 'ok' => 1, + 'skipped' => 0, + 'sub_skipped' => 0, + 'tests' => 1, + 'todo' => 0 } - }, - 'todo' => {}, - 'totals' => { - 'bad' => 1, - 'bonus' => 0, - 'files' => 1, - 'good' => 0, - 'max' => 2, - 'ok' => 1, - 'skipped' => 0, - 'sub_skipped' => 0, - 'tests' => 1, - 'todo' => 0 - } - } + }) + : () + ) }; my $num_tests = ( keys %$results ) * $PER_LOOP; diff --git a/t/iterators.t b/t/iterators.t index 57e20401..470b7070 100644 --- a/t/iterators.t +++ b/t/iterators.t @@ -155,16 +155,20 @@ for my $test (@schedule) { { + my $iterator; # coverage test for VMS case - my $iterator = make_iterator( - [ 'not ', - 'ok 1 - I hate VMS', - ] - ); + SKIP : { + skip('Not VMS', 1) if $^O ne 'VMS'; + $iterator = make_iterator( + [ 'not ', + 'ok 1 - I hate VMS', + ] + ); - is $iterator->next, 'not ok 1 - I hate VMS', - 'coverage of VMS line-splitting case'; + is $iterator->next, 'not ok 1 - I hate VMS', + 'coverage of VMS line-splitting case'; + } # coverage test for VMS case - nothing after 'not' diff --git a/t/multiplexer.t b/t/multiplexer.t index 2e55b12d..ccd1911e 100644 --- a/t/multiplexer.t +++ b/t/multiplexer.t @@ -153,6 +153,9 @@ for my $test (@schedule) { # use Data::Dumper; # diag Dumper( { stash => $stash, result => $result } ); + my @err = $parser->parse_errors(); + ok(!@err, "$name: Parser has no parse errors"); + diag @err if @err; if ( defined $result ) { my $expect = ( shift @$stash ) || ' OOPS '; my $got = $result->raw;