#!/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_compat => {
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 TAPx::Harness::Compatible::Straps;
my @_INC = map {qq{"-I$_"}} @INC;
$TAPx::Harness::Compatible::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 = TAPx::Harness::Compatible::Straps->new;
isa_ok( $strap, 'TAPx::Harness::Compatible::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 = TAPx::Harness::Compatible::Straps->new;
isa_ok( $strap, 'TAPx::Harness::Compatible::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"
);
}