From: Nicholas Clark Date: Wed, 19 Dec 2007 21:49:49 +0000 (+0000) Subject: Extraneous test files that change 32659 failed to delete. Oops. X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=51dec9fbf4e22b52a6dc53b947c56fbe52417f25;p=p5sagit%2Fp5-mst-13.2.git Extraneous test files that change 32659 failed to delete. Oops. (But they would not have been being run, because the only tests that are run are those that are in MANIFEST, and I had deleted them from there.) p4raw-id: //depot/perl@32662 --- diff --git a/lib/Test/Harness/t/00compile.t b/lib/Test/Harness/t/00compile.t deleted file mode 100644 index 0b8ad82..0000000 --- a/lib/Test/Harness/t/00compile.t +++ /dev/null @@ -1,32 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if($ENV{PERL_CORE}) { - chdir 't'; - @INC = '../lib'; - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 8; - -BEGIN { use_ok 'Test::Harness' } -BEGIN { diag( "Testing Test::Harness $Test::Harness::VERSION under Perl $] and Test::More $Test::More::VERSION" ) unless $ENV{PERL_CORE}} - -BEGIN { use_ok 'Test::Harness::Straps' } - -BEGIN { use_ok 'Test::Harness::Iterator' } - -BEGIN { use_ok 'Test::Harness::Assert' } - -BEGIN { use_ok 'Test::Harness::Point' } - -BEGIN { use_ok 'Test::Harness::Results' } - -BEGIN { use_ok 'Test::Harness::Util' } - -# If the $VERSION is set improperly, this will spew big warnings. -BEGIN { use_ok 'Test::Harness', 1.1601 } - diff --git a/lib/Test/Harness/t/assert.t b/lib/Test/Harness/t/assert.t deleted file mode 100644 index 48d094b..0000000 --- a/lib/Test/Harness/t/assert.t +++ /dev/null @@ -1,28 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::More tests => 7; - -BEGIN { use_ok( 'Test::Harness::Assert' ); } - - -ok( defined &assert, 'assert() exported' ); - -ok( !eval { assert( 0 ); 1 }, 'assert( FALSE ) causes death' ); -like( $@, '/Assert failed/', ' with the right message' ); - -ok( eval { assert( 1 ); 1 }, 'assert( TRUE ) does nothing' ); - -ok( !eval { assert( 0, 'some name' ); 1 }, 'assert( FALSE, NAME )' ); -like( $@, '/some name/', ' has the name' ); diff --git a/lib/Test/Harness/t/callback.t b/lib/Test/Harness/t/callback.t deleted file mode 100644 index 9681aa7..0000000 --- a/lib/Test/Harness/t/callback.t +++ /dev/null @@ -1,69 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More; -use File::Spec; - -BEGIN { - use vars qw( %samples ); - - %samples = ( - bailout => [qw( header test test test bailout )], - combined => ['header', ('test') x 10], - descriptive => ['header', ('test') x 5 ], - duplicates => ['header', ('test') x 11 ], - head_end => [qw( other test test test test - other header other other )], - head_fail => [qw( other test test test test - other header other other )], - no_nums => ['header', ('test') x 5 ], - out_of_order=> [('test') x 10, 'header', ('test') x 5], - simple => [qw( header test test test test test )], - simple_fail => [qw( header test test test test test )], - 'skip' => [qw( header test test test test test )], - skipall => [qw( header )], - skipall_nomsg => [qw( header )], - skip_nomsg => [qw( header test )], - taint => [qw( header test )], - 'todo' => [qw( header test test test test test )], - todo_inline => [qw( header test test test )], - vms_nit => [qw( header other test test )], - with_comments => [qw( other header other test other test test - test other other test other )], - ); - plan tests => 2 + scalar keys %samples; -} - -BEGIN { use_ok( 'Test::Harness::Straps' ); } - -my $Curdir = File::Spec->curdir; -my $SAMPLE_TESTS = $ENV{PERL_CORE} - ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') - : File::Spec->catdir($Curdir, 't', 'sample-tests'); - -my $strap = Test::Harness::Straps->new; -isa_ok( $strap, 'Test::Harness::Straps' ); -$strap->set_callback( - sub { - my($self, $line, $type, $totals) = @_; - push @out, $type; - } -); - -for my $test ( sort keys %samples ) { - my $expect = $samples{$test}; - - local @out = (); - $strap->analyze_file(File::Spec->catfile($SAMPLE_TESTS, $test)); - - is_deeply(\@out, $expect, "$test callback"); -} diff --git a/lib/Test/Harness/t/failure.t b/lib/Test/Harness/t/failure.t deleted file mode 100644 index 76d8dc9..0000000 --- a/lib/Test/Harness/t/failure.t +++ /dev/null @@ -1,53 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if ($^O eq 'VMS') { - print '1..0 # Child test output confuses parent test counter'; - exit; - } -} - -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; - -use Test::More tests => 6; -use File::Spec; - -BEGIN { - use_ok( 'Test::Harness' ); -} - -my $died; -sub prepare_for_death { $died = 0; } -sub signal_death { $died = 1; } - -my $Curdir = File::Spec->curdir; -my $SAMPLE_TESTS = $ENV{PERL_CORE} - ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') - : File::Spec->catdir($Curdir, 't', 'sample-tests'); - -PASSING: { - local $SIG{__DIE__} = \&signal_death; - prepare_for_death(); - eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "simple" ) ) }; - ok( !$@, "simple lives" ); - is( $died, 0, "Death never happened" ); -} - -FAILING: { - local $SIG{__DIE__} = \&signal_death; - prepare_for_death(); - eval { runtests( File::Spec->catfile( $SAMPLE_TESTS, "too_many" ) ) }; - ok( $@, "$@" ); - ok( $@ =~ m[Failed 1/1], "too_many dies" ); - is( $died, 1, "Death happened" ); -} diff --git a/lib/Test/Harness/t/from_line.t b/lib/Test/Harness/t/from_line.t deleted file mode 100644 index b9e7264..0000000 --- a/lib/Test/Harness/t/from_line.t +++ /dev/null @@ -1,64 +0,0 @@ -#!perl -Tw - -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = '../lib'; - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 23; - -BEGIN { - use_ok( 'Test::Harness::Point' ); -} - -BASIC_OK: { - my $line = "ok 14 - Blah blah"; - my $point = Test::Harness::Point->from_test_line( $line ); - isa_ok( $point, 'Test::Harness::Point', 'BASIC_OK' ); - is( $point->number, 14 ); - ok( $point->ok ); - is( $point->description, 'Blah blah' ); -} - -BASIC_NOT_OK: { - my $line = "not ok 267 Yada"; - my $point = Test::Harness::Point->from_test_line( $line ); - isa_ok( $point, 'Test::Harness::Point', 'BASIC_NOT_OK' ); - is( $point->number, 267 ); - ok( !$point->ok ); - is( $point->description, 'Yada' ); -} - -CRAP: { - my $point = Test::Harness::Point->from_test_line( 'ok14 - Blah' ); - ok( !defined $point, 'CRAP 1' ); - - $point = Test::Harness::Point->from_test_line( 'notok 14' ); - ok( !defined $point, 'CRAP 2' ); -} - -PARSE_TODO: { - my $point = Test::Harness::Point->from_test_line( 'not ok 14 - Calculate sqrt(-1) # TODO Still too rational' ); - isa_ok( $point, 'Test::Harness::Point', 'PARSE_TODO' ); - is( $point->description, 'Calculate sqrt(-1)' ); - is( $point->directive_type, 'todo' ); - is( $point->directive_reason, 'Still too rational' ); - ok( !$point->is_skip ); - ok( $point->is_todo ); -} - -PARSE_SKIP: { - my $point = Test::Harness::Point->from_test_line( 'ok 14 # skip Not on bucket #6' ); - isa_ok( $point, 'Test::Harness::Point', 'PARSE_SKIP' ); - is( $point->description, '' ); - is( $point->directive_type, 'skip' ); - is( $point->directive_reason, 'Not on bucket #6' ); - ok( $point->is_skip ); - ok( !$point->is_todo ); -} diff --git a/lib/Test/Harness/t/inc_taint.t b/lib/Test/Harness/t/inc_taint.t deleted file mode 100644 index 4db5555..0000000 --- a/lib/Test/Harness/t/inc_taint.t +++ /dev/null @@ -1,26 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::Harness; -use Test::More tests => 1; -use Dev::Null; - -push @INC, 'we_added_this_lib'; - -tie *NULL, 'Dev::Null' or die $!; -select NULL; -my($tot, $failed) = Test::Harness::execute_tests( - tests => [ $ENV{PERL_CORE} ? 'lib/sample-tests/inc_taint' : 't/sample-tests/inc_taint' ] -); -select STDOUT; - -ok( Test::Harness::_all_ok($tot), 'tests with taint on preserve @INC' ); diff --git a/lib/Test/Harness/t/nonumbers.t b/lib/Test/Harness/t/nonumbers.t deleted file mode 100644 index a5dc411..0000000 --- a/lib/Test/Harness/t/nonumbers.t +++ /dev/null @@ -1,14 +0,0 @@ -if( $ENV{PERL_CORE} && !$ENV{HARNESS_ACTIVE} ) { - print "1..0 # Skip: t/TEST needs numbers\n"; - exit; -} - -print < 52; - -BEGIN { - use_ok( 'Test::Harness::Point' ); - use_ok( 'Test::Harness::Straps' ); -} - -my $strap = Test::Harness::Straps->new; -isa_ok( $strap, 'Test::Harness::Straps', 'new()' ); - - -my $testlines = { - 'not ok' => { - ok => 0 - }, - 'not ok # TODO' => { - ok => 0, - reason => '', - type => 'todo' - }, - 'not ok 1' => { - number => 1, - ok => 0 - }, - 'not ok 11 - this is \\# all the name # skip this is not' => { - description => 'this is \\# all the name', - number => 11, - ok => 0, - reason => 'this is not', - type => 'skip' - }, - 'not ok 23 # TODO world peace' => { - number => 23, - ok => 0, - reason => 'world peace', - type => 'todo' - }, - 'not ok 42 - universal constant' => { - description => 'universal constant', - number => 42, - ok => 0 - }, - ok => { - ok => 1 - }, - 'ok # skip' => { - ok => 1, - type => 'skip' - }, - 'ok 1' => { - number => 1, - ok => 1 - }, - 'ok 1066 - and all that' => { - description => 'and all that', - number => 1066, - ok => 1 - }, - 'ok 11 - have life # TODO get a life' => { - description => 'have life', - number => 11, - ok => 1, - reason => 'get a life', - type => 'todo' - }, - 'ok 2938' => { - number => 2938, - ok => 1 - }, - 'ok 42 - _is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because' => { - description => '_is_header() is a header \'1..192 todo 4 2 13 192 \\# Skip skip skip because', - number => 42, - ok => 1 - } -}; -my @untests = ( - ' ok', - 'not', - 'okay 23', - ); - -for my $line ( sort keys %$testlines ) { - my $point = Test::Harness::Point->from_test_line( $line ); - isa_ok( $point, 'Test::Harness::Point' ); - - my $fields = $testlines->{$line}; - for my $property ( sort keys %$fields ) { - my $value = $fields->{$property}; - is( eval "\$point->$property", $value, "$property on $line" ); - # Perls pre-5.6 can't handle $point->$property, and must be eval()d - } -} diff --git a/lib/Test/Harness/t/point.t b/lib/Test/Harness/t/point.t deleted file mode 100644 index 1c8cf9d..0000000 --- a/lib/Test/Harness/t/point.t +++ /dev/null @@ -1,58 +0,0 @@ -#!perl -Tw - -BEGIN { - if ( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 11; - -BEGIN { - use_ok( 'Test::Harness::Point' ); -} - -my $point = Test::Harness::Point->new; -isa_ok( $point, 'Test::Harness::Point' ); -ok( !$point->ok, "Should start out not OK" ); - -$point->set_ok( 1 ); -ok( $point->ok, "should have turned to true" ); - -$point->set_ok( 0 ); -ok( !$point->ok, "should have turned false" ); - -$point->set_number( 2112 ); -is( $point->number, 2112, "Number is set" ); - -$point->set_description( "Blah blah" ); -is( $point->description, "Blah blah", "Description set" ); - -$point->set_directive( "Go now" ); -is( $point->directive, "Go now", "Directive set" ); - -$point->add_diagnostic( "# Line 1" ); -$point->add_diagnostic( "# Line two" ); -$point->add_diagnostic( "# Third line" ); -my @diags = $point->diagnostics; -is( @diags, 3, "Three lines" ); -is_deeply( - \@diags, - [ "# Line 1", "# Line two", "# Third line" ], - "Diagnostics in list context" -); - -my $diagstr = <diagnostics; -is( $string_diagnostics, $diagstr, "Diagnostics in scalar context" ); diff --git a/lib/Test/Harness/t/prove-globbing.t b/lib/Test/Harness/t/prove-globbing.t deleted file mode 100644 index 22f8770..0000000 --- a/lib/Test/Harness/t/prove-globbing.t +++ /dev/null @@ -1,32 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use File::Spec; -use Test::More; -plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE}; -plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; - -plan tests => 1; - -my $tests = File::Spec->catfile( 't', 'prove*.t' ); -my $prove = File::Spec->catfile( File::Spec->curdir, "blib", "script", "prove" ); -$prove = "$^X $prove"; - -GLOBBAGE: { - my @actual = sort qx/$prove --dry $tests/; - chomp @actual; - - my @expected = ( - File::Spec->catfile( "t", "prove-globbing.t" ), - File::Spec->catfile( "t", "prove-switches.t" ), - ); - is_deeply( \@actual, \@expected, "Expands the wildcards" ); -} diff --git a/lib/Test/Harness/t/prove-switches.t b/lib/Test/Harness/t/prove-switches.t deleted file mode 100644 index 89a74aa..0000000 --- a/lib/Test/Harness/t/prove-switches.t +++ /dev/null @@ -1,71 +0,0 @@ -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use File::Spec; -use Test::More; -plan skip_all => "Not adapted to perl core" if $ENV{PERL_CORE}; -plan skip_all => "Not installing prove" if -e "t/SKIP-PROVE"; - -plan tests => 8; - -my $blib = File::Spec->catfile( File::Spec->curdir, "blib" ); -my $blib_lib = File::Spec->catfile( $blib, "lib" ); -my $blib_arch = File::Spec->catfile( $blib, "arch" ); -my $prove = File::Spec->catfile( $blib, "script", "prove" ); -$prove = "$^X $prove"; - -CAPITAL_TAINT: { - local $ENV{PROVE_SWITCHES}; - - my @actual = qx/$prove -Ifirst -D -I second -Ithird -Tvdb/; - my @expected = ( "# \$Test::Harness::Switches: -T -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); - is_deeply( \@actual, \@expected, "Capital taint flags OK" ); -} - -LOWERCASE_TAINT: { - local $ENV{PROVE_SWITCHES}; - - my @actual = qx/$prove -dD -Ifirst -I second -t -Ithird -vb/; - my @expected = ( "# \$Test::Harness::Switches: -t -I$blib_arch -I$blib_lib -Ifirst -Isecond -Ithird\n" ); - is_deeply( \@actual, \@expected, "Lowercase taint OK" ); -} - -PROVE_SWITCHES: { - local $ENV{PROVE_SWITCHES} = "-dvb -I fark"; - - my @actual = qx/$prove -Ibork -Dd/; - my @expected = ( "# \$Test::Harness::Switches: -I$blib_arch -I$blib_lib -Ifark -Ibork\n" ); - is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" ); -} - -PROVE_SWITCHES_L: { - my @actual = qx/$prove -l -Ibongo -Dd/; - my @expected = ( "# \$Test::Harness::Switches: -Ilib -Ibongo\n" ); - is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" ); -} - -PROVE_SWITCHES_LB: { - my @actual = qx/$prove -lb -Dd/; - my @expected = ( "# \$Test::Harness::Switches: -Ilib -I$blib_arch -I$blib_lib\n" ); - is_deeply( \@actual, \@expected, "PROVE_SWITCHES OK" ); -} - -PROVE_VERSION: { - # This also checks that the prove $VERSION is in sync with Test::Harness's $VERSION - local $/ = undef; - - use_ok( 'Test::Harness' ); - - my $thv = $Test::Harness::VERSION; - my @actual = qx/$prove --version/; - is( scalar @actual, 1, 'Only 1 line returned' ); - like( $actual[0], qq{/^\Qprove v$thv, using Test::Harness v$thv and Perl v5\E/} ); -} diff --git a/lib/Test/Harness/t/strap-analyze.t b/lib/Test/Harness/t/strap-analyze.t deleted file mode 100644 index 4e38ee3..0000000 --- a/lib/Test/Harness/t/strap-analyze.t +++ /dev/null @@ -1,599 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use Test::More tests => 247; -use File::Spec; - -my $Curdir = File::Spec->curdir; -my $SAMPLE_TESTS = $ENV{PERL_CORE} - ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') - : File::Spec->catdir($Curdir, 't', 'sample-tests'); - - -my $IsMacPerl = $^O eq 'MacOS'; -my $IsVMS = $^O eq 'VMS'; - -# VMS uses native, not POSIX, exit codes. -my $die_exit = $IsVMS ? 44 : 1; - -# We can only predict that the wait status should be zero or not. -my $wait_non_zero = 1; - -my %samples = ( - bignum => { - bonus => 0, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1 - } - ], - 'exit' => 0, - max => 2, - ok => 4, - passing => 0, - seen => 4, - skip => 0, - todo => 0, - 'wait' => 0 - }, - combined => { - bonus => 1, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - name => "basset hounds got long ears", - ok => 1 - }, - { - actual_ok => 0, - name => "all hell broke lose", - ok => 0 - }, - { - actual_ok => 1, - ok => 1, - type => "todo" - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1, - reason => "contract negociations", - type => "skip" - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 0, - ok => 0 - }, - { - actual_ok => 0, - ok => 1, - type => "todo" - } - ], - 'exit' => 0, - max => 10, - ok => 8, - passing => 0, - seen => 10, - skip => 1, - todo => 2, - 'wait' => 0 - }, - descriptive => { - bonus => 0, - details => [ - { - actual_ok => 1, - name => "Interlock activated", - ok => 1 - }, - { - actual_ok => 1, - name => "Megathrusters are go", - ok => 1 - }, - { - actual_ok => 1, - name => "Head formed", - ok => 1 - }, - { - actual_ok => 1, - name => "Blazing sword formed", - ok => 1 - }, - { - actual_ok => 1, - name => "Robeast destroyed", - ok => 1 - } - ], - 'exit' => 0, - max => 5, - ok => 5, - passing => 1, - seen => 5, - skip => 0, - todo => 0, - 'wait' => 0 - }, - 'die' => { - bonus => 0, - details => [], - 'exit' => $die_exit, - max => 0, - ok => 0, - passing => 0, - seen => 0, - skip => 0, - todo => 0, - 'wait' => $wait_non_zero - }, - die_head_end => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 4, - ], - 'exit' => $die_exit, - max => 0, - ok => 4, - passing => 0, - seen => 4, - skip => 0, - todo => 0, - 'wait' => $wait_non_zero - }, - die_last_minute => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 4, - ], - 'exit' => $die_exit, - max => 4, - ok => 4, - passing => 0, - seen => 4, - skip => 0, - todo => 0, - 'wait' => $wait_non_zero - }, - duplicates => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 10, - ], - 'exit' => 0, - max => 10, - ok => 11, - passing => 0, - seen => 11, - skip => 0, - todo => 0, - 'wait' => 0 - }, - head_end => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 3, - { - actual_ok => 1, - diagnostics => "comment\nmore ignored stuff\nand yet more\n", - ok => 1 - } - ], - 'exit' => 0, - max => 4, - ok => 4, - passing => 1, - seen => 4, - skip => 0, - todo => 0, - 'wait' => 0 - }, - head_fail => { - bonus => 0, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 0, - ok => 0 - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - diagnostics => "comment\nmore ignored stuff\nand yet more\n", - ok => 1 - } - ], - 'exit' => 0, - max => 4, - ok => 3, - passing => 0, - seen => 4, - skip => 0, - todo => 0, - 'wait' => 0 - }, - lone_not_bug => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 4, - ], - 'exit' => 0, - max => 4, - ok => 4, - passing => 1, - seen => 4, - skip => 0, - todo => 0, - 'wait' => 0 - }, - no_output => { - bonus => 0, - details => [], - 'exit' => 0, - max => 0, - ok => 0, - passing => 0, - seen => 0, - skip => 0, - todo => 0, - 'wait' => 0 - }, - shbang_misparse => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 2, - ], - 'exit' => 0, - max => 2, - ok => 2, - passing => 1, - seen => 2, - skip => 0, - todo => 0, - 'wait' => 0 - }, - simple => { - bonus => 0, - details => [ - ({ - actual_ok => 1, - ok => 1 - }) x 5, - ], - 'exit' => 0, - max => 5, - ok => 5, - passing => 1, - seen => 5, - skip => 0, - todo => 0, - 'wait' => 0 - }, - simple_fail => { - bonus => 0, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 0, - ok => 0 - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 0, - ok => 0 - } - ], - 'exit' => 0, - max => 5, - ok => 3, - passing => 0, - seen => 5, - skip => 0, - todo => 0, - 'wait' => 0 - }, - skip => { - bonus => 0, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1, - reason => "rain delay", - type => "skip" - }, - ({ - actual_ok => 1, - ok => 1 - }) x 3, - ], - 'exit' => 0, - max => 5, - ok => 5, - passing => 1, - seen => 5, - skip => 1, - todo => 0, - 'wait' => 0 - }, - skip_nomsg => { - bonus => 0, - details => [ - { - actual_ok => 1, - ok => 1, - reason => "", - type => "skip" - } - ], - 'exit' => 0, - max => 1, - ok => 1, - passing => 1, - seen => 1, - skip => 1, - todo => 0, - 'wait' => 0 - }, - skipall => { - bonus => 0, - details => [], - 'exit' => 0, - max => 0, - ok => 0, - passing => 1, - seen => 0, - skip => 0, - skip_all => "rope", - todo => 0, - 'wait' => 0 - }, - skipall_nomsg => { - bonus => 0, - details => [], - 'exit' => 0, - max => 0, - ok => 0, - passing => 1, - seen => 0, - skip => 0, - skip_all => "", - todo => 0, - 'wait' => 0 - }, - taint => { - bonus => 0, - details => [ - { - actual_ok => 1, - name => "-T honored", - ok => 1 - } - ], - 'exit' => 0, - max => 1, - ok => 1, - passing => 1, - seen => 1, - skip => 0, - todo => 0, - 'wait' => 0 - }, - todo => { - bonus => 1, - details => [ - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 1, - ok => 1, - type => "todo" - }, - { - actual_ok => 0, - ok => 1, - type => "todo" - }, - ({ - actual_ok => 1, - ok => 1 - }) x 2, - ], - 'exit' => 0, - max => 5, - ok => 5, - passing => 1, - seen => 5, - skip => 0, - todo => 2, - 'wait' => 0 - }, - vms_nit => { - bonus => 0, - details => [ - { - actual_ok => 0, - ok => 0 - }, - { - actual_ok => 1, - ok => 1 - } - ], - 'exit' => 0, - max => 2, - ok => 1, - passing => 0, - seen => 2, - skip => 0, - todo => 0, - 'wait' => 0 - }, - with_comments => { - bonus => 2, - details => [ - { - actual_ok => 0, - diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n", - ok => 1, - type => "todo" - }, - { - actual_ok => 1, - ok => 1, - reason => "at line 10 TODO?!)", - type => "todo" - }, - { - actual_ok => 1, - ok => 1 - }, - { - actual_ok => 0, - diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n Expected: '1' (need more tuits)\n", - ok => 1, - type => "todo" - }, - { - actual_ok => 1, - diagnostics => "woo\n", - ok => 1, - reason => "at line 13 TODO?!)", - type => "todo" - } - ], - 'exit' => 0, - max => 5, - ok => 5, - passing => 1, - seen => 5, - skip => 0, - todo => 4, - 'wait' => 0 - }, -); - -use Test::Harness::Straps; -my @_INC = map { qq{"-I$_"} } @INC; -$Test::Harness::Switches = "@_INC -Mstrict"; - -$SIG{__WARN__} = sub { - warn @_ unless $_[0] =~ /^Enormous test number/ || - $_[0] =~ /^Can't detailize/ -}; - -for my $test ( sort keys %samples ) { - print "# Working on $test\n"; - my $expect = $samples{$test}; - - for my $n ( 0..$#{$expect->{details}} ) { - for my $field ( qw( type name reason ) ) { - $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field}; - } - } - - my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - my $results = $strap->analyze_file($test_path); - - is_deeply($results->details, $expect->{details}, qq{details of "$test"} ); - - delete $expect->{details}; - - SKIP: { - skip '$? unreliable in MacPerl', 2 if $IsMacPerl; - - # We can only check if it's zero or non-zero. - is( !$results->wait, !$expect->{'wait'}, 'wait status' ); - delete $expect->{'wait'}; - - # Have to check the exit status seperately so we can skip it - # in MacPerl. - is( $results->exit, $expect->{'exit'}, 'exit matches' ); - delete $expect->{'exit'}; - } - - for my $field ( sort keys %$expect ) { - is( $results->$field(), $expect->{$field}, "Field $field" ); - } -} # for %samples - -NON_EXISTENT_FILE: { - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - ok( !$strap->analyze_file('I_dont_exist'), "Can't analyze a non-existant file" ); - is( $strap->{error}, "I_dont_exist does not exist", "And there should be one error" ); -} diff --git a/lib/Test/Harness/t/strap.t b/lib/Test/Harness/t/strap.t deleted file mode 100644 index 16ff9cf..0000000 --- a/lib/Test/Harness/t/strap.t +++ /dev/null @@ -1,158 +0,0 @@ -#!/usr/bin/perl -Tw - -use strict; - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use Test::More tests => 89; - -BEGIN { use_ok('Test::Harness::Straps'); } - -my $strap = Test::Harness::Straps->new; -isa_ok( $strap, 'Test::Harness::Straps', 'new()' ); - -### Testing _is_diagnostic() - -my $comment; -ok( !$strap->_is_diagnostic("foo", \$comment), '_is_diagnostic(), not a comment' ); -ok( !defined $comment, ' no comment set' ); - -ok( !$strap->_is_diagnostic("f # oo", \$comment), ' not a comment with #' ); -ok( !defined $comment, ' no comment set' ); - -my %comments = ( - "# stuff and things # and stuff" => - ' stuff and things # and stuff', - " # more things " => ' more things ', - "#" => '', - ); - -for my $line ( sort keys %comments ) { - my $line_comment = $comments{$line}; - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - my $name = substr($line, 0, 20); - ok( $strap->_is_diagnostic($line, \$comment), " comment '$name'" ); - is( $comment, $line_comment, ' right comment set' ); -} - - - -### Testing _is_header() - -my @not_headers = (' 1..2', - '1..M', - '1..-1', - '2..2', - '1..a', - '', - ); - -foreach my $unheader (@not_headers) { - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - ok( !$strap->_is_header($unheader), - "_is_header(), not a header '$unheader'" ); - - ok( (!grep { exists $strap->{$_} } qw(max todo skip_all)), - " max, todo and skip_all are not set" ); -} - - -my @attribs = qw(max skip_all todo); -my %headers = ( - '1..2' => { max => 2 }, - '1..1' => { max => 1 }, - '1..0' => { max => 0, - skip_all => '', - }, - '1..0 # Skipped: no leverage found' => { max => 0, - skip_all => 'no leverage found', - }, - '1..4 # Skipped: no leverage found' => { max => 4, - skip_all => 'no leverage found', - }, - '1..0 # skip skip skip because' => { max => 0, - skip_all => 'skip skip because', - }, - '1..10 todo 2 4 10' => { max => 10, - 'todo' => { 2 => 1, - 4 => 1, - 10 => 1, - }, - }, - '1..10 todo' => { max => 10 }, - '1..192 todo 4 2 13 192 # Skip skip skip because' => - { max => 192, - 'todo' => { 4 => 1, - 2 => 1, - 13 => 1, - 192 => 1, - }, - skip_all => 'skip skip because' - } -); - -for my $header ( sort keys %headers ) { - my $expect = $headers{$header}; - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - ok( $strap->_is_header($header), "_is_header() is a header '$header'" ); - - is( $strap->{skip_all}, $expect->{skip_all}, ' skip_all set right' ) - if defined $expect->{skip_all}; - - ok( eq_set( [map $strap->{$_}, grep defined $strap->{$_}, @attribs], - [map $expect->{$_}, grep defined $expect->{$_}, @attribs] ), - ' the right attributes are there' ); -} - - - -### Test _is_bail_out() - -my %bails = ( - 'Bail out!' => undef, - 'Bail out! Wing on fire.' => 'Wing on fire.', - 'BAIL OUT!' => undef, - 'bail out! - Out of coffee' => '- Out of coffee', - ); - -for my $line ( sort keys %bails ) { - my $expect = $bails{$line}; - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - my $reason; - ok( $strap->_is_bail_out($line, \$reason), "_is_bail_out() spots '$line'"); - is( $reason, $expect, ' with the right reason' ); -} - -my @unbails = ( - ' Bail out!', - 'BAIL OUT', - 'frobnitz', - 'ok 23 - BAIL OUT!', - ); - -foreach my $line (@unbails) { - my $strap = Test::Harness::Straps->new; - isa_ok( $strap, 'Test::Harness::Straps' ); - - my $reason; - - ok( !$strap->_is_bail_out($line, \$reason), - "_is_bail_out() ignores '$line'" ); - is( $reason, undef, ' and gives no reason' ); -} diff --git a/lib/Test/Harness/t/test-harness.t b/lib/Test/Harness/t/test-harness.t deleted file mode 100644 index 88d28a9..0000000 --- a/lib/Test/Harness/t/test-harness.t +++ /dev/null @@ -1,562 +0,0 @@ -#!/usr/bin/perl -w - -BEGIN { - if( $ENV{PERL_CORE} ) { - chdir 't'; - @INC = ('../lib', 'lib'); - } - else { - unshift @INC, 't/lib'; - } -} - -use strict; -use File::Spec; - -my $Curdir = File::Spec->curdir; -my $SAMPLE_TESTS = $ENV{PERL_CORE} - ? File::Spec->catdir($Curdir, 'lib', 'sample-tests') - : File::Spec->catdir($Curdir, 't', 'sample-tests'); - - -use Test::More; -use Dev::Null; - -my $IsMacPerl = $^O eq 'MacOS'; -my $IsVMS = $^O eq 'VMS'; - -# VMS uses native, not POSIX, exit codes. -# MacPerl's exit codes are broken. -my $die_estat = $IsVMS ? 44 : - $IsMacPerl ? 0 : - 1; - -my %samples = ( - simple => { - total => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - simple_fail => { - total => { - bonus => 0, - max => 5, - 'ok' => 3, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped => 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '2 5', - }, - all_ok => 0, - }, - descriptive => { - total => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - no_nums => { - total => { - bonus => 0, - max => 5, - 'ok' => 4, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '3', - }, - all_ok => 0, - }, - 'todo' => { - total => { - bonus => 1, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 2, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - todo_inline => { - total => { - bonus => 1, - max => 3, - 'ok' => 3, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped => 0, - 'todo' => 2, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - 'skip' => { - total => { - bonus => 0, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 1, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - 'skip_nomsg' => { - total => { - bonus => 0, - max => 1, - 'ok' => 1, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 1, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - bailout => 0, - combined => { - total => { - bonus => 1, - max => 10, - 'ok' => 8, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 1, - 'todo' => 2, - skipped => 0 - }, - failed => { - canon => '3 9', - }, - all_ok => 0, - }, - duplicates => { - total => { - bonus => 0, - max => 10, - 'ok' => 11, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '??', - }, - all_ok => 0, - }, - head_end => { - total => { - bonus => 0, - max => 4, - 'ok' => 4, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - head_fail => { - total => { - bonus => 0, - max => 4, - 'ok' => 3, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '2', - }, - all_ok => 0, - }, - no_output => { - total => { - bonus => 0, - max => 0, - 'ok' => 0, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped => 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - }, - all_ok => 0, - }, - skipall => { - total => { - bonus => 0, - max => 0, - 'ok' => 0, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 1, - }, - failed => { }, - all_ok => 1, - }, - skipall_nomsg => { - total => { - bonus => 0, - max => 0, - 'ok' => 0, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 1, - }, - failed => { }, - all_ok => 1, - }, - with_comments => { - total => { - bonus => 2, - max => 5, - 'ok' => 5, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 4, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - taint => { - total => { - bonus => 0, - max => 1, - 'ok' => 1, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - - taint_warn => { - total => { - bonus => 0, - max => 1, - 'ok' => 1, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - - 'die' => { - total => { - bonus => 0, - max => 0, - 'ok' => 0, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - estat => $die_estat, - max => '??', - failed => '??', - canon => '??', - }, - all_ok => 0, - }, - - die_head_end => { - total => { - bonus => 0, - max => 0, - 'ok' => 4, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - estat => $die_estat, - max => '??', - failed => '??', - canon => '??', - }, - all_ok => 0, - }, - - die_last_minute => { - total => { - bonus => 0, - max => 4, - 'ok' => 4, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - estat => $die_estat, - max => 4, - failed => 0, - canon => '??', - }, - all_ok => 0, - }, - bignum => { - total => { - bonus => 0, - max => 2, - 'ok' => 4, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '??', - }, - all_ok => 0, - }, - bignum_many => { - total => { - bonus => 0, - max => 2, - 'ok' => 11, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '3-100000', - }, - all_ok => 0, - }, - 'shbang_misparse' => { - total => { - bonus => 0, - max => 2, - 'ok' => 2, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - too_many => { - total => { - bonus => 0, - max => 3, - 'ok' => 7, - files => 1, - bad => 1, - good => 0, - tests => 1, - sub_skipped => 0, - 'todo' => 0, - skipped => 0, - }, - failed => { - canon => '4-7', - }, - all_ok => 0, - }, - switches => { - total => { - bonus => 0, - max => 1, - 'ok' => 1, - files => 1, - bad => 0, - good => 1, - tests => 1, - sub_skipped=> 0, - 'todo' => 0, - skipped => 0, - }, - failed => { }, - all_ok => 1, - }, - ); - -my $tests_per_loop = 8; -plan tests => (keys(%samples) * $tests_per_loop); - -use Test::Harness; -my @_INC = map { qq{"-I$_"} } @INC; -$Test::Harness::Switches = "@_INC -Mstrict"; - -tie *NULL, 'Dev::Null' or die $!; - -for my $test ( sort keys %samples ) { -SKIP: { - skip "-t introduced in 5.8.0", $tests_per_loop - if ($test eq 'taint_warn') && ($] < 5.008); - - my $expect = $samples{$test}; - - # execute_tests() runs the tests but skips the formatting. - my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); - - print STDERR "# $test\n" if $ENV{TEST_VERBOSE}; - my $totals; - my $failed; - my $warning = ''; - eval { - local $SIG{__WARN__} = sub { $warning .= join '', @_; }; - ($totals, $failed) = Test::Harness::execute_tests(tests => [$test_path], out => \*NULL); - }; - - # $? is unreliable in MacPerl, so we'll just fudge it. - $failed->{estat} = $die_estat if $IsMacPerl and $failed; - - SKIP: { - skip "special tests for bailout", 1 unless $test eq 'bailout'; - like( $@, '/Further testing stopped: GERONI/i' ); - } - - SKIP: { - skip "don't apply to a bailout", 6 if $test eq 'bailout'; - is( $@, '', '$@ is empty' ); - is( Test::Harness::_all_ok($totals), $expect->{all_ok}, - "$test - all ok" ); - ok( defined $expect->{total}, "$test - has total" ); - is_deeply( {map { $_=>$totals->{$_} } keys %{$expect->{total}}}, - $expect->{total}, - "$test - totals" ); - is_deeply( {map { $_=>$failed->{$test_path}{$_} } - keys %{$expect->{failed}}}, - $expect->{failed}, - "$test - failed" ); - - skip "No tests were run", 1 unless $totals->{max}; - - my $output = Test::Harness::get_results($totals, $failed); - like( $output, '/All tests successful|List of Failed/', 'Got what looks like a valid summary' ); - } - - my $expected_warnings = ""; - if ( $test eq "bignum" ) { - $expected_warnings = < 3; - -BEGIN { - use_ok('Test::Harness'); -} - -my $ver = $ENV{HARNESS_VERSION} or die "HARNESS_VERSION not set"; -ok( $ver =~ /^2.\d\d(_\d\d)?$/, "Version is proper format" ); -is( $ver, $Test::Harness::VERSION );