From 2a7f4b9b0713cc512aacba1593d634a47060e42e Mon Sep 17 00:00:00 2001 From: Steve Peters Date: Fri, 29 Feb 2008 04:10:17 +0000 Subject: Upgrade to Test-Harness-3.10 p4raw-id: //depot/perl@33393 --- lib/Test/Harness.pm | 4 +-- lib/Test/Harness/t/000-load.t | 3 ++- lib/Test/Harness/t/grammar.t | 58 ++++++++++++++++++++++++++++++++++++++--- lib/Test/Harness/t/parse.t | 44 ++++++++++++++++++++++++++----- lib/Test/Harness/t/regression.t | 48 +++++++++++++++++++++++++++++++--- 5 files changed, 140 insertions(+), 17 deletions(-) (limited to 'lib/Test') diff --git a/lib/Test/Harness.pm b/lib/Test/Harness.pm index 14af275db3..17e891653b 100644 --- a/lib/Test/Harness.pm +++ b/lib/Test/Harness.pm @@ -43,11 +43,11 @@ Test::Harness - Run Perl standard test scripts with statistics =head1 VERSION -Version 3.09 +Version 3.10 =cut -$VERSION = '3.09'; +$VERSION = '3.10'; # Backwards compatibility for exportable variable names. *verbose = *Verbose; diff --git a/lib/Test/Harness/t/000-load.t b/lib/Test/Harness/t/000-load.t index 5e4554aa22..5c952a7f27 100644 --- a/lib/Test/Harness/t/000-load.t +++ b/lib/Test/Harness/t/000-load.t @@ -3,7 +3,7 @@ use strict; use lib 't/lib'; -use Test::More tests => 60; +use Test::More tests => 62; BEGIN { @@ -28,6 +28,7 @@ BEGIN { TAP::Parser::Result::Bailout TAP::Parser::Result::Comment TAP::Parser::Result::Plan + TAP::Parser::Result::Pragma TAP::Parser::Result::Test TAP::Parser::Result::Unknown TAP::Parser::Result::Version diff --git a/lib/Test/Harness/t/grammar.t b/lib/Test/Harness/t/grammar.t index 107cd77aca..6d572f9082 100644 --- a/lib/Test/Harness/t/grammar.t +++ b/lib/Test/Harness/t/grammar.t @@ -3,7 +3,7 @@ use strict; use lib 't/lib'; -use Test::More tests => 81; +use Test::More tests => 94; use TAP::Parser::Grammar; use TAP::Parser::Iterator::Array; @@ -41,8 +41,8 @@ isa_ok $grammar, $GRAMMAR, '... and the object it returns'; # why. We'll still use the instance because that should be forward # compatible. -my @V12 = qw(bailout comment plan simple_test test version); -my @V13 = ( @V12, 'yaml' ); +my @V12 = sort qw(bailout comment plan simple_test test version); +my @V13 = sort ( @V12, 'pragma', 'yaml' ); can_ok $grammar, 'token_types'; ok my @types = sort( $grammar->token_types ), @@ -265,6 +265,56 @@ $expected = { 'test_num' => '22', 'raw' => 'ok 22 this is a test \# TODO whee!' }; +is_deeply $token, $expected, + '... and the token should contain the correct data'; + +# pragmas + +my $pragma = 'pragma +strict'; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => ['+strict'], +}; + +is_deeply $token, $expected, + '... and the token should contain the correct data'; + +$pragma = 'pragma +strict,-foo'; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => [ '+strict', '-foo' ], +}; + +is_deeply $token, $expected, + '... and the token should contain the correct data'; + +$pragma = 'pragma +strict , -foo '; +like $pragma, $syntax_for{'pragma'}, 'Pragmas should match the pragma syntax'; + +$stream->put($pragma); +ok $token = $grammar->tokenize, + '... and calling it with data should return a token'; + +$expected = { + 'type' => 'pragma', + 'raw' => $pragma, + 'pragmas' => [ '+strict', '-foo' ], +}; + is_deeply $token, $expected, '... and the token should contain the correct data'; @@ -281,7 +331,7 @@ is_deeply $token, $expected, $grammar->set_version('no_such_version'); }; - unless (is @die, 1, 'set_version with bad version') { + unless ( is @die, 1, 'set_version with bad version' ) { diag " >>> $_ <<<\n" for @die; } diff --git a/lib/Test/Harness/t/parse.t b/lib/Test/Harness/t/parse.t index 6e5c585273..a53ad3a746 100755 --- a/lib/Test/Harness/t/parse.t +++ b/lib/Test/Harness/t/parse.t @@ -3,16 +3,16 @@ use strict; BEGIN { - if( $ENV{PERL_CORE} ) { + if ( $ENV{PERL_CORE} ) { chdir 't'; - @INC = ('../lib', 'lib'); + @INC = ( '../lib', 'lib' ); } else { - use lib 't/lib'; + use lib 't/lib'; } } -use Test::More tests => 260; +use Test::More tests => 268; use IO::c55Capture; use File::Spec; @@ -29,9 +29,10 @@ sub _get_results { return @results; } -my ( $PARSER, $PLAN, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw( +my ( $PARSER, $PLAN, $PRAGMA, $TEST, $COMMENT, $BAILOUT, $UNKNOWN, $YAML, $VERSION ) = qw( TAP::Parser TAP::Parser::Result::Plan + TAP::Parser::Result::Pragma TAP::Parser::Result::Test TAP::Parser::Result::Comment TAP::Parser::Result::Bailout @@ -624,8 +625,10 @@ END_TAP # coverage test of perl source with switches my $parser = TAP::Parser->new( - { source => File::Spec->catfile( ($ENV{PERL_CORE} ? 'lib' : 't'), - 'sample-tests', 'simple' ), + { source => File::Spec->catfile( + ( $ENV{PERL_CORE} ? 'lib' : 't' ), + 'sample-tests', 'simple' + ), } ); @@ -988,3 +991,30 @@ END_TAP qr/Panic: planned test count [(]1001[)] did not equal sum of passed [(]0[)] and failed [(]2[)] tests!/, '...and the message is as we expect'; } + +{ + + # Sanity check on state table + + my $parser = TAP::Parser->new( { tap => "1..1\nok 1\n" } ); + my $state_table = $parser->_make_state_table; + my @states = sort keys %$state_table; + my @expect = sort qw( + bailout comment plan pragma test unknown version yaml + ); + + my %reachable = ( INIT => 1 ); + + for my $name (@states) { + my $state = $state_table->{$name}; + my @can_handle = sort keys %$state; + is_deeply \@can_handle, \@expect, "token types handled in $name"; + for my $type (@can_handle) { + $reachable{$_}++ + for grep {defined} + map { $state->{$type}->{$_} } qw(goto continue); + } + } + + is_deeply [ sort keys %reachable ], [@states], "all states reachable"; +} diff --git a/lib/Test/Harness/t/regression.t b/lib/Test/Harness/t/regression.t index 80902df361..5398580c7b 100644 --- a/lib/Test/Harness/t/regression.t +++ b/lib/Test/Harness/t/regression.t @@ -2245,6 +2245,48 @@ my %samples = ( wait => 0, version => 13, }, + strict => { + results => [ + { is_version => TRUE, + raw => 'TAP version 13', + }, + { is_plan => TRUE, + raw => '1..1', + }, + { is_pragma => TRUE, + raw => 'pragma +strict', + pragmas => ['+strict'], + }, + { is_unknown => TRUE, raw => 'Nonsense!', + }, + { is_pragma => TRUE, + raw => 'pragma -strict', + pragmas => ['-strict'], + }, + { is_unknown => TRUE, + raw => "Doesn't matter.", + }, + { is_test => TRUE, + raw => 'ok 1 All OK', + } + ], + plan => '1..1', + passed => [1], + actual_passed => [1], + failed => [], + actual_failed => [], + todo => [], + todo_passed => [], + skipped => [], + good_plan => TRUE, + is_good_plan => TRUE, + tests_planned => 1, + tests_run => 1, + parse_errors => ['Unknown TAP token: "Nonsense!"'], + 'exit' => 0, # TODO: Is this right??? + wait => 0, + version => 13, + }, skipall_nomsg => { results => [ { is_plan => TRUE, @@ -2803,7 +2845,7 @@ my %samples = ( tests_planned => 5, tests_run => 5, parse_errors => - [ 'Explicit TAP version must be at least 13. Got version 12' ], + ['Explicit TAP version must be at least 13. Got version 12'], 'exit' => 0, wait => 0, version => 12, @@ -2883,7 +2925,7 @@ my %samples = ( tests_planned => 5, tests_run => 5, parse_errors => - [ 'If TAP version is present it must be the first line of output' ], + ['If TAP version is present it must be the first line of output'], 'exit' => 0, wait => 0, version => 12, @@ -3121,7 +3163,7 @@ sub analyze_test { "... and $method should return a reasonable value ($test/$count)"; } elsif ( ref $answer ) { - is_deeply $result->$method(), $answer, + is_deeply scalar( $result->$method() ), $answer, "... and $method should return the correct structure ($test/$count)"; } else { -- cgit v1.2.1