#!/usr/bin/perl -w BEGIN { if( $ENV{PERL_CORE} ) { chdir 't'; @INC = ('../lib', 'lib'); } else { unshift @INC, 't/lib'; } } use strict; use Test::More; 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 $IsMacOS = $^O eq 'MacOS'; my $IsVMS = $^O eq 'VMS'; # VMS uses native, not POSIX, exit codes. my $die_exit = $IsVMS ? 44 : $IsMacOS ? 0 : 1; # We can only predict that the wait status should be zero or not. my $wait_non_zero = 1; my %samples = ( combined => { passing => 0, 'exit' => 0, 'wait' => 0, max => 10, seen => 10, 'ok' => 8, 'todo' => 2, 'skip' => 1, bonus => 1, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1, name => 'basset hounds got long ears', }, { 'ok' => 0, actual_ok => 0, name => 'all hell broke lose', }, { 'ok' => 1, actual_ok => 1, type => 'todo' }, { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1, type => 'skip', reason => 'contract negociations' }, { 'ok' => 1, actual_ok => 1 }, { 'ok' => 0, actual_ok => 0 }, { 'ok' => 1, actual_ok => 0, type => 'todo' }, ] }, descriptive => { passing => 1, 'wait' => 0, 'exit' => 0, max => 5, seen => 5, 'ok' => 5, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 1, 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' }, ], }, duplicates => { passing => 0, 'exit' => 0, 'wait' => 0, max => 10, seen => 11, 'ok' => 11, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 10 ], }, head_end => { passing => 1, 'exit' => 0, 'wait' => 0, max => 4, seen => 4, 'ok' => 4, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 ], }, lone_not_bug => { passing => 1, 'exit' => 0, 'wait' => 0, max => 4, seen => 4, 'ok' => 4, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 ], }, head_fail => { passing => 0, 'exit' => 0, 'wait' => 0, max => 4, seen => 4, 'ok' => 3, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 0, actual_ok => 0 }, ({ 'ok'=> 1, actual_ok => 1 }) x 2 ], }, simple => { passing => 1, 'exit' => 0, 'wait' => 0, max => 5, seen => 5, 'ok' => 5, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 5 ] }, simple_fail => { passing => 0, 'exit' => 0, 'wait' => 0, max => 5, seen => 5, 'ok' => 3, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 0, actual_ok => 0 }, { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1 }, { 'ok' => 0, actual_ok => 0 }, ] }, 'skip' => { passing => 1, 'exit' => 0, 'wait' => 0, max => 5, seen => 5, 'ok' => 5, 'todo' => 0, 'skip' => 1, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1, type => 'skip', reason => 'rain delay', }, ({ 'ok' => 1, actual_ok => 1 }) x 3 ] }, 'skip_nomsg' => { passing => 1, 'exit' => 0, 'wait' => 0, max => 1, seen => 1, 'ok' => 1, 'todo' => 0, 'skip' => 1, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1, type => 'skip', reason => '', }, ] }, skipall => { passing => 1, 'exit' => 0, 'wait' => 0, max => 0, seen => 0, skip_all => 'rope', 'ok' => 0, 'todo' => 0, 'skip' => 0, bonus => 0, details => [], }, skipall_nomsg => { passing => 1, 'exit' => 0, 'wait' => 0, max => 0, seen => 0, 'ok' => 0, 'todo' => 0, 'skip' => 0, bonus => 0, details => [], }, 'todo' => { passing => 1, 'exit' => 0, 'wait' => 0, max => 5, seen => 5, 'ok' => 5, 'todo' => 2, 'skip' => 0, bonus => 1, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1, type => 'todo' }, { 'ok' => 1, actual_ok => 0, type => 'todo' }, ({ 'ok' => 1, actual_ok => 1 }) x 2 ], }, taint => { passing => 1, 'exit' => 0, 'wait' => 0, max => 1, seen => 1, 'ok' => 1, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1, name => '- -T honored' }, ], }, vms_nit => { passing => 0, 'exit' => 0, 'wait' => 0, max => 2, seen => 2, 'ok' => 1, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 0, actual_ok => 0 }, { 'ok' => 1, actual_ok => 1 }, ], }, 'die' => { passing => 0, 'exit' => $die_exit, 'wait' => $wait_non_zero, max => 0, seen => 0, 'ok' => 0, 'todo' => 0, 'skip' => 0, bonus => 0, details => [] }, die_head_end => { passing => 0, 'exit' => $die_exit, 'wait' => $wait_non_zero, max => 0, seen => 4, 'ok' => 4, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 ], }, die_last_minute => { passing => 0, 'exit' => $die_exit, 'wait' => $wait_non_zero, max => 4, seen => 4, 'ok' => 4, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 4 ], }, bignum => { passing => 0, 'exit' => 0, 'wait' => 0, max => 2, seen => 4, 'ok' => 4, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ { 'ok' => 1, actual_ok => 1 }, { 'ok' => 1, actual_ok => 1 }, ] }, 'shbang_misparse' =>{ passing => 1, 'exit' => 0, 'wait' => 0, max => 2, seen => 2, 'ok' => 2, 'todo' => 0, 'skip' => 0, bonus => 0, details => [ ({ 'ok' => 1, actual_ok => 1 }) x 2 ] }, ); plan tests => (keys(%samples) * 4) + 3; use_ok('Test::Harness::Straps'); $SIG{__WARN__} = sub { warn @_ unless $_[0] =~ /^Enormous test number/ || $_[0] =~ /^Can't detailize/ }; while( my($test, $expect) = each %samples ) { for (0..$#{$expect->{details}}) { $expect->{details}[$_]{type} = '' unless exists $expect->{details}[$_]{type}; $expect->{details}[$_]{name} = '' unless exists $expect->{details}[$_]{name}; $expect->{details}[$_]{reason} = '' unless exists $expect->{details}[$_]{reason}; } my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test); my $strap = Test::Harness::Straps->new; my %results = $strap->analyze_file($test_path); is_deeply($results{details}, $expect->{details}, "$test details" ); delete $expect->{details}; delete $results{details}; SKIP: { skip '$? unreliable in MacPerl', 2 if $IsMacOS; # We can only check if it's zero or non-zero. is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' ); delete $results{'wait'}; delete $expect->{'wait'}; # Have to check the exit status seperately so we can skip it # in MacPerl. is( $results{'exit'}, $expect->{'exit'} ); delete $results{'exit'}; delete $expect->{'exit'}; } is_deeply(\%results, $expect, " the rest $test" ); } my $strap = Test::Harness::Straps->new; ok( !$strap->analyze_file('I_dont_exist') ); is( $strap->{error}, "I_dont_exist does not exist" );