4 if ( $ENV{PERL_CORE} ) {
6 @INC = ( '../lib', 'lib' );
23 @ISA = qw( App::Prove );
27 my $self = $class->SUPER::new(@_);
32 sub _color_default {0}
36 push @{ $self->{_log} }, [ '_runtests', @_ ];
41 my @log = @{ $self->{_log} };
55 return [ map { File::Spec->rel2abs($_) } @$ar ];
61 sub test_log_import { push @import_log, [@_] }
64 my @log = @import_log;
70 my ( @ATTR, %DEFAULT_ASSERTION, @SCHEDULE );
72 # see the "ACTUAL TEST" section at the bottom
78 archive argv blib color directives exec extension failures
79 formatter harness includes lib merge parse quiet really_quiet
80 recurse backwards shuffle taint_fail taint_warn verbose
81 warnings_fail warnings_warn
84 # what we expect if the 'expect' hash does not define it
85 %DEFAULT_ASSERTION = map { $_ => undef } @ATTR;
87 $DEFAULT_ASSERTION{includes} = $DEFAULT_ASSERTION{argv}
88 = sub { 'ARRAY' eq ref shift };
90 my @dummy_tests = map { File::Spec->catdir( 't', 'sample-tests', $_ ) }
91 qw(simple simple_yaml);
92 my $dummy_test = $dummy_tests[0];
94 ########################################################################
95 # declarations - this drives all of the subtests.
96 # The cheatsheet follows.
97 # required: name, expect
99 # args - arguments to constructor
100 # switches - command-line switches
101 # runlog - expected results of internal calls to _runtests, must
102 # match FakeProve's _log attr
103 # run_error - depends on 'runlog' (if missing, asserts no error)
104 # extra - follow-up check to handle exceptional cleanup / verification
105 # class - The App::Prove subclass to test. Defaults to FakeProve
107 { name => 'Create empty',
110 { name => 'Set all options via constructor',
113 argv => [qw(one two three)],
121 includes => [qw(four five six)],
138 argv => [qw(one two three)],
146 includes => [qw(four five six)],
162 { name => 'Call with defaults',
163 args => { argv => [qw( one two three )] },
176 # Test all options individually
178 # { name => 'Just archive',
180 # argv => [qw( one two three )],
195 { name => 'Just argv',
197 argv => [qw( one two three )],
200 argv => [qw( one two three )],
211 { name => 'Just blib',
213 argv => [qw( one two three )],
221 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
225 'one', 'two', 'three'
230 { name => 'Just color',
232 argv => [qw( one two three )],
244 'one', 'two', 'three'
249 { name => 'Just directives',
251 argv => [qw( one two three )],
263 'one', 'two', 'three'
267 { name => 'Just exec',
269 argv => [qw( one two three )],
281 'one', 'two', 'three'
285 { name => 'Just failures',
287 argv => [qw( one two three )],
299 'one', 'two', 'three'
304 { name => 'Just formatter',
306 argv => [qw( one two three )],
307 formatter => 'TAP::Harness',
310 formatter => 'TAP::Harness',
314 { formatter_class => 'TAP::Harness',
318 'one', 'two', 'three'
323 { name => 'Just includes',
325 argv => [qw( one two three )],
326 includes => [qw( four five six )],
329 includes => [qw( four five six )],
333 { lib => mabs( [qw( four five six )] ),
337 'one', 'two', 'three'
341 { name => 'Just lib',
343 argv => [qw( one two three )],
351 { lib => mabs( ['lib'] ),
355 'one', 'two', 'three'
359 { name => 'Just merge',
361 argv => [qw( one two three )],
373 'one', 'two', 'three'
377 { name => 'Just parse',
379 argv => [qw( one two three )],
391 'one', 'two', 'three'
395 { name => 'Just quiet',
397 argv => [qw( one two three )],
408 'one', 'two', 'three'
412 { name => 'Just really_quiet',
414 argv => [qw( one two three )],
425 'one', 'two', 'three'
429 { name => 'Just recurse',
431 argv => [qw( one two three )],
441 'one', 'two', 'three'
445 { name => 'Just reverse',
447 argv => [qw( one two three )],
457 'three', 'two', 'one'
462 { name => 'Just shuffle',
464 argv => [qw( one two three )],
479 { name => 'Just taint_fail',
481 argv => [qw( one two three )],
489 { switches => ['-T'],
493 'one', 'two', 'three'
497 { name => 'Just taint_warn',
499 argv => [qw( one two three )],
507 { switches => ['-t'],
511 'one', 'two', 'three'
515 { name => 'Just verbose',
517 argv => [qw( one two three )],
528 'one', 'two', 'three'
532 { name => 'Just warnings_fail',
534 argv => [qw( one two three )],
542 { switches => ['-W'],
546 'one', 'two', 'three'
550 { name => 'Just warnings_warn',
552 argv => [qw( one two three )],
560 { switches => ['-w'],
564 'one', 'two', 'three'
569 # Command line parsing
570 { name => 'Switch -v',
572 argv => [qw( one two three )],
574 switches => [ '-v', $dummy_test ],
588 { name => 'Switch --verbose',
590 argv => [qw( one two three )],
592 switches => [ '--verbose', $dummy_test ],
606 { name => 'Switch -f',
608 argv => [qw( one two three )],
610 switches => [ '-f', $dummy_test ],
611 expect => { failures => 1 },
623 { name => 'Switch --failures',
625 argv => [qw( one two three )],
627 switches => [ '--failures', $dummy_test ],
628 expect => { failures => 1 },
640 { name => 'Switch -l',
642 argv => [qw( one two three )],
644 switches => [ '-l', $dummy_test ],
645 expect => { lib => 1 },
648 { lib => mabs( ['lib'] ),
657 { name => 'Switch --lib',
659 argv => [qw( one two three )],
661 switches => [ '--lib', $dummy_test ],
662 expect => { lib => 1 },
665 { lib => mabs( ['lib'] ),
674 { name => 'Switch -b',
676 argv => [qw( one two three )],
678 switches => [ '-b', $dummy_test ],
679 expect => { blib => 1 },
682 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
691 { name => 'Switch --blib',
693 argv => [qw( one two three )],
695 switches => [ '--blib', $dummy_test ],
696 expect => { blib => 1 },
699 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
708 { name => 'Switch -s',
710 argv => [qw( one two three )],
712 switches => [ '-s', $dummy_test ],
713 expect => { shuffle => 1 },
723 { name => 'Switch --shuffle',
725 argv => [qw( one two three )],
727 switches => [ '--shuffle', $dummy_test ],
728 expect => { shuffle => 1 },
738 { name => 'Switch -c',
740 argv => [qw( one two three )],
742 switches => [ '-c', $dummy_test ],
743 expect => { color => 1 },
755 { name => 'Switch -r',
757 argv => [qw( one two three )],
759 switches => [ '-r', $dummy_test ],
760 expect => { recurse => 1 },
770 { name => 'Switch --recurse',
772 argv => [qw( one two three )],
774 switches => [ '--recurse', $dummy_test ],
775 expect => { recurse => 1 },
785 { name => 'Switch --reverse',
787 argv => [qw( one two three )],
789 switches => [ '--reverse', @dummy_tests ],
790 expect => { backwards => 1 },
800 { name => 'Switch -p',
802 argv => [qw( one two three )],
804 switches => [ '-p', $dummy_test ],
819 { name => 'Switch --parse',
821 argv => [qw( one two three )],
823 switches => [ '--parse', $dummy_test ],
838 { name => 'Switch -q',
840 argv => [qw( one two three )],
842 switches => [ '-q', $dummy_test ],
843 expect => { quiet => 1 },
854 { name => 'Switch --quiet',
856 argv => [qw( one two three )],
858 switches => [ '--quiet', $dummy_test ],
859 expect => { quiet => 1 },
870 { name => 'Switch -Q',
872 argv => [qw( one two three )],
874 switches => [ '-Q', $dummy_test ],
875 expect => { really_quiet => 1 },
886 { name => 'Switch --QUIET',
888 argv => [qw( one two three )],
890 switches => [ '--QUIET', $dummy_test ],
891 expect => { really_quiet => 1 },
902 { name => 'Switch -m',
904 argv => [qw( one two three )],
906 switches => [ '-m', $dummy_test ],
907 expect => { merge => 1 },
919 { name => 'Switch --merge',
921 argv => [qw( one two three )],
923 switches => [ '--merge', $dummy_test ],
924 expect => { merge => 1 },
936 { name => 'Switch --directives',
938 argv => [qw( one two three )],
940 switches => [ '--directives', $dummy_test ],
941 expect => { directives => 1 },
953 # Executing one word (why would it be a -s though?)
954 { name => 'Switch --exec -s',
956 argv => [qw( one two three )],
958 switches => [ '--exec', '-s', $dummy_test ],
959 expect => { exec => '-s' },
961 [ '_runtests', { exec => ['-s'], verbosity => 0 },
969 { name => 'Switch --exec "/foo/bar/perl -Ilib"',
971 argv => [qw( one two three )],
973 switches => [ '--exec', '/foo/bar/perl -Ilib', $dummy_test ],
974 expect => { exec => '/foo/bar/perl -Ilib' },
977 { exec => [qw(/foo/bar/perl -Ilib)],
986 # null exec (run tests as compiled binaries)
987 { name => 'Switch --exec ""',
988 switches => [ '--exec', '', $dummy_test ],
990 exec => # ick, must workaround the || default bit with a sub
991 sub { my $val = shift; defined($val) and !length($val) }
995 { exec => [], verbosity => 0 },
1003 { name => 'Load plugin',
1004 switches => [ '-P', 'Dummy', $dummy_test ],
1006 argv => [qw( one two three )],
1009 plugins => ['Dummy'],
1012 my @loaded = get_import_log();
1013 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1026 { name => 'Load plugin (args)',
1027 switches => [ '-P', 'Dummy=cracking,cheese,gromit', $dummy_test ],
1029 argv => [qw( one two three )],
1032 plugins => ['Dummy'],
1035 my @loaded = get_import_log();
1037 [ [ 'App::Prove::Plugin::Dummy', 'cracking', 'cheese',
1053 { name => 'Load plugin (explicit path)',
1054 switches => [ '-P', 'App::Prove::Plugin::Dummy', $dummy_test ],
1056 argv => [qw( one two three )],
1059 plugins => ['Dummy'],
1062 my @loaded = get_import_log();
1063 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1076 { name => 'Load module',
1077 switches => [ '-M', 'App::Prove::Plugin::Dummy', $dummy_test ],
1079 argv => [qw( one two three )],
1082 plugins => ['Dummy'],
1085 my @loaded = get_import_log();
1086 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1100 # Hmm, that doesn't work...
1101 # { name => 'Switch -h',
1103 # argv => [qw( one two three )],
1105 # switches => [ '-h', $dummy_test ],
1116 # { name => 'Switch --help',
1118 # argv => [qw( one two three )],
1120 # switches => [ '--help', $dummy_test ],
1129 # { name => 'Switch -?',
1131 # argv => [qw( one two three )],
1133 # switches => [ '-?', $dummy_test ],
1143 # { name => 'Switch -H',
1145 # argv => [qw( one two three )],
1147 # switches => [ '-H', $dummy_test ],
1157 # { name => 'Switch --man',
1159 # argv => [qw( one two three )],
1161 # switches => [ '--man', $dummy_test ],
1171 # { name => 'Switch -V',
1173 # argv => [qw( one two three )],
1175 # switches => [ '-V', $dummy_test ],
1185 # { name => 'Switch --version',
1187 # argv => [qw( one two three )],
1189 # switches => [ '--version', $dummy_test ],
1199 # { name => 'Switch --color!',
1201 # argv => [qw( one two three )],
1203 # switches => [ '--color!', $dummy_test ],
1213 { name => 'Switch -I=s@',
1215 argv => [qw( one two three )],
1217 switches => [ '-Ilib', $dummy_test ],
1220 my ( $val, $attr ) = @_;
1224 && $val->[0] =~ /lib$/;
1229 # { name => 'Switch -a',
1231 # argv => [qw( one two three )],
1233 # switches => [ '-a', $dummy_test ],
1243 # { name => 'Switch --archive=-s',
1245 # argv => [qw( one two three )],
1247 # switches => [ '--archive=-s', $dummy_test ],
1257 # { name => 'Switch --formatter=-s',
1259 # argv => [qw( one two three )],
1261 # switches => [ '--formatter=-s', $dummy_test ],
1271 # { name => 'Switch -e',
1273 # argv => [qw( one two three )],
1275 # switches => [ '-e', $dummy_test ],
1285 # { name => 'Switch --harness=-s',
1287 # argv => [qw( one two three )],
1289 # switches => [ '--harness=-s', $dummy_test ],
1302 ########################################################################
1305 for my $test (@SCHEDULE) {
1306 $extra_plan += $test->{plan} || 0;
1307 $extra_plan += 2 if $test->{runlog};
1308 $extra_plan += 1 if $test->{switches};
1311 plan tests => @SCHEDULE * ( 3 + @ATTR ) + $extra_plan;
1315 for my $test (@SCHEDULE) {
1316 my $name = $test->{name};
1317 my $class = $test->{class} || 'FakeProve';
1319 ok my $app = $class->new( exists $test->{args} ? $test->{args} : () ),
1320 "$name: App::Prove created OK";
1322 isa_ok $app, 'App::Prove';
1323 isa_ok $app, $class;
1325 # Optionally parse command args
1326 if ( my $switches = $test->{switches} ) {
1327 eval { $app->process_args( '--norc', @$switches ) };
1328 if ( my $err_pattern = $test->{parse_error} ) {
1329 like $@, $err_pattern, "$name: expected parse error";
1332 ok !$@, "$name: no parse error";
1336 my $expect = $test->{expect} || {};
1337 for my $attr ( sort @ATTR ) {
1338 my $val = $app->$attr();
1339 my $assertion = $expect->{$attr} || $DEFAULT_ASSERTION{$attr};
1342 if ( 'CODE' eq ref $assertion ) {
1343 $is_ok = ok $assertion->( $val, $attr ),
1344 "$name: $attr has the expected value";
1346 elsif ( 'Regexp' eq ref $assertion ) {
1347 $is_ok = like $val, $assertion, "$name: $attr matches $assertion";
1350 $is_ok = is_deeply $val, $assertion,
1351 "$name: $attr has the expected value";
1355 diag "got $val for $attr";
1359 if ( my $runlog = $test->{runlog} ) {
1361 if ( my $err_pattern = $test->{run_error} ) {
1362 like $@, $err_pattern, "$name: expected error OK";
1364 pass for 1 .. $test->{plan};
1367 unless ( ok !$@, "$name: no error OK" ) {
1368 diag "$name: error: $@\n";
1371 my $gotlog = [ $app->get_log ];
1373 if ( my $extra = $test->{extra} ) {
1378 is_deeply $gotlog, $runlog,
1379 "$name: run results match"
1383 diag Dumper( { wanted => $runlog, got => $gotlog } );