#!/usr/bin/perl -w
BEGIN {
unshift @INC, 't/lib';
}
use strict;
use Test::More;
use File::Spec;
use App::Prove;
use Getopt::Long;
use TAP::Parser::Utils qw( split_shell );
package FakeProve;
use vars qw( @ISA );
@ISA = qw( App::Prove );
sub new {
my $class = shift;
my $self = $class->SUPER::new(@_);
$self->{_log} = [];
return $self;
}
sub _color_default {0}
sub _runtests {
my $self = shift;
push @{ $self->{_log} }, [ '_runtests', @_ ];
}
sub get_log {
my $self = shift;
my @log = @{ $self->{_log} };
$self->{_log} = [];
return @log;
}
sub _shuffle {
my $self = shift;
s/^/xxx/ for @_;
}
package main;
sub mabs {
my $ar = shift;
return [ map { File::Spec->rel2abs($_) } @$ar ];
}
{
my @import_log = ();
sub test_log_import { push @import_log, [@_] }
sub get_import_log {
my @log = @import_log;
@import_log = ();
return @log;
}
my @plugin_load_log = ();
sub test_log_plugin_load { push @plugin_load_log, [@_] }
sub get_plugin_load_log {
my @log = @plugin_load_log;
@plugin_load_log = ();
return @log;
}
}
my ( @ATTR, %DEFAULT_ASSERTION, @SCHEDULE, $HAS_YAML );
# see the "ACTUAL TEST" section at the bottom
BEGIN { # START PLAN
$HAS_YAML = 0;
eval { require YAML; $HAS_YAML = 1; };
# list of attributes
@ATTR = qw(
archive argv blib color directives exec extensions failures
formatter harness includes lib merge parse quiet really_quiet
recurse backwards shuffle taint_fail taint_warn verbose
warnings_fail warnings_warn
);
# what we expect if the 'expect' hash does not define it
%DEFAULT_ASSERTION = map { $_ => undef } @ATTR;
$DEFAULT_ASSERTION{includes} = $DEFAULT_ASSERTION{argv}
= sub { 'ARRAY' eq ref shift };
my @dummy_tests = map { File::Spec->catdir( 't', 'sample-tests', $_ ) }
qw(simple simple_yaml);
my $dummy_test = $dummy_tests[0];
########################################################################
# declarations - this drives all of the subtests.
# The cheatsheet follows.
# required: name, expect
# optional:
# args - arguments to constructor
# switches - command-line switches
# runlog - expected results of internal calls to _runtests, must
# match FakeProve's _log attr
# run_error - depends on 'runlog' (if missing, asserts no error)
# extra - follow-up check to handle exceptional cleanup / verification
# class - The App::Prove subclass to test. Defaults to FakeProve
@SCHEDULE = (
{ name => 'Create empty',
expect => {}
},
{ name => 'Set all options via constructor',
args => {
archive => 1,
argv => [qw(one two three)],
blib => 2,
color => 3,
directives => 4,
exec => 5,
failures => 7,
formatter => 8,
harness => 9,
includes => [qw(four five six)],
lib => 10,
merge => 11,
parse => 13,
quiet => 14,
really_quiet => 15,
recurse => 16,
backwards => 17,
shuffle => 18,
taint_fail => 19,
taint_warn => 20,
verbose => 21,
warnings_fail => 22,
warnings_warn => 23,
},
expect => {
archive => 1,
argv => [qw(one two three)],
blib => 2,
color => 3,
directives => 4,
exec => 5,
failures => 7,
formatter => 8,
harness => 9,
includes => [qw(four five six)],
lib => 10,
merge => 11,
parse => 13,
quiet => 14,
really_quiet => 15,
recurse => 16,
backwards => 17,
shuffle => 18,
taint_fail => 19,
taint_warn => 20,
verbose => 21,
warnings_fail => 22,
warnings_warn => 23,
}
},
{ name => 'Call with defaults',
args => { argv => [qw( one two three )] },
expect => {},
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
# Test all options individually
# { name => 'Just archive',
# args => {
# argv => [qw( one two three )],
# archive => 1,
# },
# expect => {
# archive => 1,
# },
# runlog => [
# [ { archive => 1,
# },
# 'TAP::Harness',
# 'one', 'two',
# 'three'
# ]
# ],
# },
{ name => 'Just argv',
args => {
argv => [qw( one two three )],
},
expect => {
argv => [qw( one two three )],
},
runlog => [
[ '_runtests',
{ verbosity => 0, show_count => 1 },
'TAP::Harness',
'one', 'two',
'three'
]
],
},
{ name => 'Just blib',
args => {
argv => [qw( one two three )],
blib => 1,
},
expect => {
blib => 1,
},
runlog => [
[ '_runtests',
{ lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just color',
args => {
argv => [qw( one two three )],
color => 1,
},
expect => {
color => 1,
},
runlog => [
[ '_runtests',
{ color => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just directives',
args => {
argv => [qw( one two three )],
directives => 1,
},
expect => {
directives => 1,
},
runlog => [
[ '_runtests',
{ directives => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just exec',
args => {
argv => [qw( one two three )],
exec => 1,
},
expect => {
exec => 1,
},
runlog => [
[ '_runtests',
{ exec => [1],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just failures',
args => {
argv => [qw( one two three )],
failures => 1,
},
expect => {
failures => 1,
},
runlog => [
[ '_runtests',
{ failures => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just formatter',
args => {
argv => [qw( one two three )],
formatter => 'TAP::Harness',
},
expect => {
formatter => 'TAP::Harness',
},
runlog => [
[ '_runtests',
{ formatter_class => 'TAP::Harness',
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just includes',
args => {
argv => [qw( one two three )],
includes => [qw( four five six )],
},
expect => {
includes => [qw( four five six )],
},
runlog => [
[ '_runtests',
{ lib => mabs( [qw( four five six )] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just lib',
args => {
argv => [qw( one two three )],
lib => 1,
},
expect => {
lib => 1,
},
runlog => [
[ '_runtests',
{ lib => mabs( ['lib'] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just merge',
args => {
argv => [qw( one two three )],
merge => 1,
},
expect => {
merge => 1,
},
runlog => [
[ '_runtests',
{ merge => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just parse',
args => {
argv => [qw( one two three )],
parse => 1,
},
expect => {
parse => 1,
},
runlog => [
[ '_runtests',
{ errors => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just quiet',
args => {
argv => [qw( one two three )],
quiet => 1,
},
expect => {
quiet => 1,
},
runlog => [
[ '_runtests',
{ verbosity => -1,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just really_quiet',
args => {
argv => [qw( one two three )],
really_quiet => 1,
},
expect => {
really_quiet => 1,
},
runlog => [
[ '_runtests',
{ verbosity => -2,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just recurse',
args => {
argv => [qw( one two three )],
recurse => 1,
},
expect => {
recurse => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just reverse',
args => {
argv => [qw( one two three )],
backwards => 1,
},
expect => {
backwards => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'three', 'two', 'one'
]
],
},
{ name => 'Just shuffle',
args => {
argv => [qw( one two three )],
shuffle => 1,
},
expect => {
shuffle => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'xxxone', 'xxxtwo',
'xxxthree'
]
],
},
{ name => 'Just taint_fail',
args => {
argv => [qw( one two three )],
taint_fail => 1,
},
expect => {
taint_fail => 1,
},
runlog => [
[ '_runtests',
{ switches => ['-T'],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just taint_warn',
args => {
argv => [qw( one two three )],
taint_warn => 1,
},
expect => {
taint_warn => 1,
},
runlog => [
[ '_runtests',
{ switches => ['-t'],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just verbose',
args => {
argv => [qw( one two three )],
verbose => 1,
},
expect => {
verbose => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 1,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just warnings_fail',
args => {
argv => [qw( one two three )],
warnings_fail => 1,
},
expect => {
warnings_fail => 1,
},
runlog => [
[ '_runtests',
{ switches => ['-W'],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
{ name => 'Just warnings_warn',
args => {
argv => [qw( one two three )],
warnings_warn => 1,
},
expect => {
warnings_warn => 1,
},
runlog => [
[ '_runtests',
{ switches => ['-w'],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
'one', 'two', 'three'
]
],
},
# Command line parsing
{ name => 'Switch -v',
args => {
argv => [qw( one two three )],
},
switches => [ '-v', $dummy_test ],
expect => {
verbose => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 1,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --verbose',
args => {
argv => [qw( one two three )],
},
switches => [ '--verbose', $dummy_test ],
expect => {
verbose => 1,
},
runlog => [
[ '_runtests',
{ verbosity => 1,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -f',
args => {
argv => [qw( one two three )],
},
switches => [ '-f', $dummy_test ],
expect => { failures => 1 },
runlog => [
[ '_runtests',
{ failures => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --failures',
args => {
argv => [qw( one two three )],
},
switches => [ '--failures', $dummy_test ],
expect => { failures => 1 },
runlog => [
[ '_runtests',
{ failures => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -l',
args => {
argv => [qw( one two three )],
},
switches => [ '-l', $dummy_test ],
expect => { lib => 1 },
runlog => [
[ '_runtests',
{ lib => mabs( ['lib'] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --lib',
args => {
argv => [qw( one two three )],
},
switches => [ '--lib', $dummy_test ],
expect => { lib => 1 },
runlog => [
[ '_runtests',
{ lib => mabs( ['lib'] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -b',
args => {
argv => [qw( one two three )],
},
switches => [ '-b', $dummy_test ],
expect => { blib => 1 },
runlog => [
[ '_runtests',
{ lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --blib',
args => {
argv => [qw( one two three )],
},
switches => [ '--blib', $dummy_test ],
expect => { blib => 1 },
runlog => [
[ '_runtests',
{ lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -s',
args => {
argv => [qw( one two three )],
},
switches => [ '-s', $dummy_test ],
expect => { shuffle => 1 },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
"xxx$dummy_test"
]
],
},
{ name => 'Switch --shuffle',
args => {
argv => [qw( one two three )],
},
switches => [ '--shuffle', $dummy_test ],
expect => { shuffle => 1 },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
"xxx$dummy_test"
]
],
},
{ name => 'Switch -c',
args => {
argv => [qw( one two three )],
},
switches => [ '-c', $dummy_test ],
expect => { color => 1 },
runlog => [
[ '_runtests',
{ color => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -r',
args => {
argv => [qw( one two three )],
},
switches => [ '-r', $dummy_test ],
expect => { recurse => 1 },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --recurse',
args => {
argv => [qw( one two three )],
},
switches => [ '--recurse', $dummy_test ],
expect => { recurse => 1 },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --reverse',
args => {
argv => [qw( one two three )],
},
switches => [ '--reverse', @dummy_tests ],
expect => { backwards => 1 },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
reverse @dummy_tests
]
],
},
{ name => 'Switch -p',
args => {
argv => [qw( one two three )],
},
switches => [ '-p', $dummy_test ],
expect => {
parse => 1,
},
runlog => [
[ '_runtests',
{ errors => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --parse',
args => {
argv => [qw( one two three )],
},
switches => [ '--parse', $dummy_test ],
expect => {
parse => 1,
},
runlog => [
[ '_runtests',
{ errors => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -q',
args => {
argv => [qw( one two three )],
},
switches => [ '-q', $dummy_test ],
expect => { quiet => 1 },
runlog => [
[ '_runtests',
{ verbosity => -1,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --quiet',
args => {
argv => [qw( one two three )],
},
switches => [ '--quiet', $dummy_test ],
expect => { quiet => 1 },
runlog => [
[ '_runtests',
{ verbosity => -1,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -Q',
args => {
argv => [qw( one two three )],
},
switches => [ '-Q', $dummy_test ],
expect => { really_quiet => 1 },
runlog => [
[ '_runtests',
{ verbosity => -2,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --QUIET',
args => {
argv => [qw( one two three )],
},
switches => [ '--QUIET', $dummy_test ],
expect => { really_quiet => 1 },
runlog => [
[ '_runtests',
{ verbosity => -2,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch -m',
args => {
argv => [qw( one two three )],
},
switches => [ '-m', $dummy_test ],
expect => { merge => 1 },
runlog => [
[ '_runtests',
{ merge => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --merge',
args => {
argv => [qw( one two three )],
},
switches => [ '--merge', $dummy_test ],
expect => { merge => 1 },
runlog => [
[ '_runtests',
{ merge => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --directives',
args => {
argv => [qw( one two three )],
},
switches => [ '--directives', $dummy_test ],
expect => { directives => 1 },
runlog => [
[ '_runtests',
{ directives => 1,
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# .proverc
{ name => 'Empty exec in .proverc',
args => {
argv => [qw( one two three )],
},
proverc => 't/proverc/emptyexec',
switches => [$dummy_test],
expect => { exec => '' },
runlog => [
[ '_runtests',
{ exec => [],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# Executing one word (why would it be a -s though?)
{ name => 'Switch --exec -s',
args => {
argv => [qw( one two three )],
},
switches => [ '--exec', '-s', $dummy_test ],
expect => { exec => '-s' },
runlog => [
[ '_runtests',
{ exec => ['-s'],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# multi-part exec
{ name => 'Switch --exec "/foo/bar/perl -Ilib"',
args => {
argv => [qw( one two three )],
},
switches => [ '--exec', '/foo/bar/perl -Ilib', $dummy_test ],
expect => { exec => '/foo/bar/perl -Ilib' },
runlog => [
[ '_runtests',
{ exec => [qw(/foo/bar/perl -Ilib)],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# null exec (run tests as compiled binaries)
{ name => 'Switch --exec ""',
switches => [ '--exec', '', $dummy_test ],
expect => {
exec => # ick, must workaround the || default bit with a sub
sub { my $val = shift; defined($val) and !length($val) }
},
runlog => [
[ '_runtests',
{ exec => [],
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# Specify an oddball extension
{ name => 'Switch --ext=.wango',
switches => ['--ext=.wango'],
expect => { extensions => ['.wango'] },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
]
],
},
# Handle multiple extensions
{ name => 'Switch --ext=.foo --ext=.bar',
switches => [ '--ext=.foo', '--ext=.bar', ],
expect => { extensions => [ '.foo', '.bar' ] },
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
]
],
},
# Source handlers
{ name => 'Switch --source simple',
args => { argv => [qw( one two three )] },
switches => [ '--source', 'MyCustom', $dummy_test ],
expect => {
sources => {
MyCustom => {},
},
},
runlog => [
[ '_runtests',
{ sources => {
MyCustom => {},
},
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Switch --sources with config',
args => { argv => [qw( one two three )] },
skip => $Getopt::Long::VERSION >= 2.28 && $HAS_YAML ? 0 : 1,
skip_reason => "YAML not available or Getopt::Long too old",
switches => [
'--source', 'Perl',
'--perl-option', 'foo=bar baz',
'--perl-option', 'avg=0.278',
'--source', 'MyCustom',
'--source', 'File',
'--file-option', 'extensions=.txt',
'--file-option', 'extensions=.tmp',
'--file-option', 'hash=this=that',
'--file-option', 'hash=foo=bar',
'--file-option', 'sep=foo\\=bar',
$dummy_test
],
expect => {
sources => {
Perl => { foo => 'bar baz', avg => 0.278 },
MyCustom => {},
File => {
extensions => [ '.txt', '.tmp' ],
hash => { this => 'that', foo => 'bar' },
sep => 'foo=bar',
},
},
},
runlog => [
[ '_runtests',
{ sources => {
Perl => { foo => 'bar baz', avg => 0.278 },
MyCustom => {},
File => {
extensions => [ '.txt', '.tmp' ],
hash => { this => 'that', foo => 'bar' },
sep => 'foo=bar',
},
},
verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# Plugins
{ name => 'Load plugin',
switches => [ '-P', 'Dummy', $dummy_test ],
args => {
argv => [qw( one two three )],
},
expect => {
plugins => ['Dummy'],
},
extra => sub {
my @loaded = get_import_log();
is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
"Plugin loaded OK";
},
plan => 1,
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Load plugin (args)',
switches => [ '-P', 'Dummy=cracking,cheese,gromit', $dummy_test ],
args => {
argv => [qw( one two three )],
},
expect => {
plugins => ['Dummy'],
},
extra => sub {
my @loaded = get_import_log();
is_deeply \@loaded,
[ [ 'App::Prove::Plugin::Dummy', 'cracking', 'cheese',
'gromit'
]
],
"Plugin loaded OK";
},
plan => 1,
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Load plugin (explicit path)',
switches => [ '-P', 'App::Prove::Plugin::Dummy', $dummy_test ],
args => {
argv => [qw( one two three )],
},
expect => {
plugins => ['Dummy'],
},
extra => sub {
my @loaded = get_import_log();
is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
"Plugin loaded OK";
},
plan => 1,
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Load plugin (args + call load method)',
switches => [ '-P', 'Dummy2=fou,du,fafa', $dummy_test ],
args => {
argv => [qw( one two three )],
},
expect => {
plugins => ['Dummy2'],
},
extra => sub {
my @import = get_import_log();
is_deeply \@import,
[ [ 'App::Prove::Plugin::Dummy2', 'fou', 'du', 'fafa' ] ],
"Plugin loaded OK";
my @loaded = get_plugin_load_log();
is( scalar @loaded, 1, 'Plugin->load called OK' );
my ( $plugin_class, $args ) = @{ shift @loaded };
is( $plugin_class, 'App::Prove::Plugin::Dummy2',
'plugin_class passed'
);
isa_ok(
$args->{app_prove}, 'App::Prove',
'app_prove object passed'
);
is_deeply(
$args->{args}, [qw( fou du fafa )],
'expected args passed'
);
},
plan => 5,
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
{ name => 'Load module',
switches => [ '-M', 'App::Prove::Plugin::Dummy', $dummy_test ],
args => {
argv => [qw( one two three )],
},
expect => {
plugins => ['Dummy'],
},
extra => sub {
my @loaded = get_import_log();
is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
"Plugin loaded OK";
},
plan => 1,
runlog => [
[ '_runtests',
{ verbosity => 0,
show_count => 1,
},
'TAP::Harness',
$dummy_test
]
],
},
# TODO
# Hmm, that doesn't work...
# { name => 'Switch -h',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-h', $dummy_test ],
# expect => {},
# runlog => [
# [ '_runtests',
# {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
# { name => 'Switch --help',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--help', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
# { name => 'Switch -?',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-?', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch -H',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-H', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --man',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--man', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch -V',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-V', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --version',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--version', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --color!',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--color!', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
{ name => 'Switch -I=s@',
args => {
argv => [qw( one two three )],
},
switches => [ '-Ilib', $dummy_test ],
expect => {
includes => sub {
my ( $val, $attr ) = @_;
return
'ARRAY' eq ref $val
&& 1 == @$val
&& $val->[0] =~ /lib$/;
},
},
},
# { name => 'Switch -a',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-a', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --archive=-s',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--archive=-s', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --formatter=-s',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--formatter=-s', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch -e',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '-e', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
#
# { name => 'Switch --harness=-s',
# args => {
# argv => [qw( one two three )],
# },
# switches => [ '--harness=-s', $dummy_test ],
# expect => {},
# runlog => [
# [ {},
# 'TAP::Harness',
# $dummy_test
# ]
# ],
# },
);
# END SCHEDULE
########################################################################
my $extra_plan = 0;
for my $test (@SCHEDULE) {
my $plan = 0;
$plan += $test->{plan} || 0;
$plan += 2 if $test->{runlog};
$plan += 1 if $test->{switches};
$test->{_planned} = $plan + 3 + @ATTR;
$extra_plan += $plan;
}
plan tests => @SCHEDULE * ( 3 + @ATTR ) + $extra_plan;
} # END PLAN
# ACTUAL TEST
for my $test (@SCHEDULE) {
my $name = $test->{name};
my $class = $test->{class} || 'FakeProve';
SKIP:
{
skip $test->{skip_reason}, $test->{_planned} if $test->{skip};
local $ENV{HARNESS_TIMER};
ok my $app = $class->new( exists $test->{args} ? $test->{args} : () ),
"$name: App::Prove created OK";
isa_ok $app, 'App::Prove';
isa_ok $app, $class;
# Optionally parse command args
if ( my $switches = $test->{switches} ) {
if ( my $proverc = $test->{proverc} ) {
$app->add_rc_file(
File::Spec->catfile( split /\//, $proverc ) );
}
eval { $app->process_args( '--norc', @$switches ) };
if ( my $err_pattern = $test->{parse_error} ) {
like $@, $err_pattern, "$name: expected parse error";
}
else {
ok !$@, "$name: no parse error";
}
}
my $expect = $test->{expect} || {};
for my $attr ( sort @ATTR ) {
my $val = $app->$attr();
my $assertion
= exists $expect->{$attr}
? $expect->{$attr}
: $DEFAULT_ASSERTION{$attr};
my $is_ok = undef;
if ( 'CODE' eq ref $assertion ) {
$is_ok = ok $assertion->( $val, $attr ),
"$name: $attr has the expected value";
}
elsif ( 'Regexp' eq ref $assertion ) {
$is_ok = like $val, $assertion,
"$name: $attr matches $assertion";
}
else {
$is_ok = is_deeply $val, $assertion,
"$name: $attr has the expected value";
}
unless ($is_ok) {
diag "got $val for $attr";
}
}
if ( my $runlog = $test->{runlog} ) {
eval { $app->run };
if ( my $err_pattern = $test->{run_error} ) {
like $@, $err_pattern, "$name: expected error OK";
pass;
pass for 1 .. $test->{plan};
}
else {
unless ( ok !$@, "$name: no error OK" ) {
diag "$name: error: $@\n";
}
my $gotlog = [ $app->get_log ];
if ( my $extra = $test->{extra} ) {
$extra->($gotlog);
}
# adapt our expectations if HARNESS_PERL_SWITCHES is set
push @{ $runlog->[0][1]{switches} },
split_shell( $ENV{HARNESS_PERL_SWITCHES} )
if $ENV{HARNESS_PERL_SWITCHES};
unless (
is_deeply $gotlog, $runlog,
"$name: run results match"
)
{
use Data::Dumper;
diag Dumper( { wanted => $runlog, got => $gotlog } );
}
}
}
} # SKIP
}