#!/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 }