#!/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'); # For shutting up Test::Harness. # Has to work on 5.004 which doesn't have Tie::StdHandle. package My::Dev::Null; sub WRITE {} sub PRINT {} sub PRINTF {} sub TIEHANDLE { my $class = shift; my $fh = do { local *HANDLE; \*HANDLE }; return bless $fh, $class; } sub READ {} sub READLINE {} sub GETC {} package main; use Test::More; my $IsMacOS = $^O eq 'MacOS'; my $IsVMS = $^O eq 'VMS'; # VMS uses native, not POSIX, exit codes. my $die_estat = $IsVMS ? 44 : $IsMacOS ? 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, }, 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, }, '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, }, '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, }, ); plan tests => (keys(%samples) * 8) + 1; use Test::Harness; use_ok('Test::Harness'); tie *NULL, 'My::Dev::Null' or die $!; while (my($test, $expect) = each %samples) { # _run_all_tests() runs the tests but skips the formatting. my($totals, $failed); my $warning = ''; my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); eval { select NULL; # _run_all_tests() isn't as quiet as it should be. local $SIG{__WARN__} = sub { $warning .= join '', @_; }; ($totals, $failed) = Test::Harness::_run_all_tests($test_path); }; select STDOUT; # $? is unreliable in MacPerl, so we'll simply fudge it. $failed->{estat} = $die_estat if $IsMacOS 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", 5 if $test eq 'bailout'; is( $@, '' ); 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: { skip "special tests for bignum", 1 unless $test eq 'bignum'; is( $warning, <