Upgrade to Test-Harness-3.17
[p5sagit/p5-mst-13.2.git] / ext / Test-Harness / t / prove.t
CommitLineData
b965d173 1#!/usr/bin/perl -w
2
3BEGIN {
5e2a19fc 4 if ( $ENV{PERL_CORE} ) {
5 chdir 't';
f715bbfb 6 @INC = ( '../lib', '../ext/Test-Harness/t/lib' );
5e2a19fc 7 }
8 else {
9 unshift @INC, 't/lib';
b965d173 10 }
11}
12
13use strict;
b965d173 14
15use Test::More;
16use File::Spec;
17
18use App::Prove;
19
20package FakeProve;
21use vars qw( @ISA );
22
23@ISA = qw( App::Prove );
24
25sub new {
26 my $class = shift;
27 my $self = $class->SUPER::new(@_);
28 $self->{_log} = [];
29 return $self;
30}
31
32sub _color_default {0}
33
34sub _runtests {
35 my $self = shift;
36 push @{ $self->{_log} }, [ '_runtests', @_ ];
37}
38
39sub get_log {
40 my $self = shift;
41 my @log = @{ $self->{_log} };
42 $self->{_log} = [];
43 return @log;
44}
45
46sub _shuffle {
47 my $self = shift;
48 s/^/xxx/ for @_;
49}
50
51package main;
52
53sub mabs {
54 my $ar = shift;
55 return [ map { File::Spec->rel2abs($_) } @$ar ];
56}
57
58{
59 my @import_log = ();
b965d173 60 sub test_log_import { push @import_log, [@_] }
61
62 sub get_import_log {
63 my @log = @import_log;
64 @import_log = ();
65 return @log;
66 }
bdaf8c65 67
68 my @plugin_load_log = ();
69 sub test_log_plugin_load { push @plugin_load_log, [@_] }
70
71 sub get_plugin_load_log {
72 my @log = @plugin_load_log;
73 @plugin_load_log = ();
74 return @log;
75 }
b965d173 76}
77
78my ( @ATTR, %DEFAULT_ASSERTION, @SCHEDULE );
79
80# see the "ACTUAL TEST" section at the bottom
81
82BEGIN { # START PLAN
83
84 # list of attributes
85 @ATTR = qw(
f7c69158 86 archive argv blib color directives exec extension failures
87 formatter harness includes lib merge parse quiet really_quiet
88 recurse backwards shuffle taint_fail taint_warn verbose
89 warnings_fail warnings_warn
b965d173 90 );
91
92 # what we expect if the 'expect' hash does not define it
93 %DEFAULT_ASSERTION = map { $_ => undef } @ATTR;
94
95 $DEFAULT_ASSERTION{includes} = $DEFAULT_ASSERTION{argv}
96 = sub { 'ARRAY' eq ref shift };
97
98 my @dummy_tests = map { File::Spec->catdir( 't', 'sample-tests', $_ ) }
99 qw(simple simple_yaml);
100 my $dummy_test = $dummy_tests[0];
101
102 ########################################################################
103 # declarations - this drives all of the subtests.
104 # The cheatsheet follows.
105 # required: name, expect
106 # optional:
107 # args - arguments to constructor
108 # switches - command-line switches
109 # runlog - expected results of internal calls to _runtests, must
110 # match FakeProve's _log attr
111 # run_error - depends on 'runlog' (if missing, asserts no error)
112 # extra - follow-up check to handle exceptional cleanup / verification
113 # class - The App::Prove subclass to test. Defaults to FakeProve
114 @SCHEDULE = (
115 { name => 'Create empty',
116 expect => {}
117 },
118 { name => 'Set all options via constructor',
119 args => {
120 archive => 1,
121 argv => [qw(one two three)],
122 blib => 2,
123 color => 3,
124 directives => 4,
125 exec => 5,
126 failures => 7,
127 formatter => 8,
128 harness => 9,
129 includes => [qw(four five six)],
130 lib => 10,
131 merge => 11,
132 parse => 13,
133 quiet => 14,
134 really_quiet => 15,
135 recurse => 16,
136 backwards => 17,
137 shuffle => 18,
138 taint_fail => 19,
139 taint_warn => 20,
140 verbose => 21,
141 warnings_fail => 22,
142 warnings_warn => 23,
143 },
144 expect => {
145 archive => 1,
146 argv => [qw(one two three)],
147 blib => 2,
148 color => 3,
149 directives => 4,
150 exec => 5,
151 failures => 7,
152 formatter => 8,
153 harness => 9,
154 includes => [qw(four five six)],
155 lib => 10,
156 merge => 11,
157 parse => 13,
158 quiet => 14,
159 really_quiet => 15,
160 recurse => 16,
161 backwards => 17,
162 shuffle => 18,
163 taint_fail => 19,
164 taint_warn => 20,
165 verbose => 21,
166 warnings_fail => 22,
167 warnings_warn => 23,
168 }
169 },
170 { name => 'Call with defaults',
171 args => { argv => [qw( one two three )] },
172 expect => {},
173 runlog => [
174 [ '_runtests',
27fc0087 175 { verbosity => 0,
176 show_count => 1,
177 },
b965d173 178 'TAP::Harness',
27fc0087 179 'one', 'two', 'three'
b965d173 180 ]
181 ],
182 },
183
184 # Test all options individually
185
186 # { name => 'Just archive',
187 # args => {
188 # argv => [qw( one two three )],
189 # archive => 1,
190 # },
191 # expect => {
192 # archive => 1,
193 # },
194 # runlog => [
195 # [ { archive => 1,
196 # },
197 # 'TAP::Harness',
198 # 'one', 'two',
199 # 'three'
200 # ]
201 # ],
202 # },
203 { name => 'Just argv',
204 args => {
205 argv => [qw( one two three )],
206 },
207 expect => {
208 argv => [qw( one two three )],
209 },
210 runlog => [
211 [ '_runtests',
27fc0087 212 { verbosity => 0, show_count => 1 },
b965d173 213 'TAP::Harness',
214 'one', 'two',
215 'three'
216 ]
217 ],
218 },
219 { name => 'Just blib',
220 args => {
221 argv => [qw( one two three )],
222 blib => 1,
223 },
224 expect => {
225 blib => 1,
226 },
227 runlog => [
228 [ '_runtests',
229 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
27fc0087 230 verbosity => 0,
231 show_count => 1,
b965d173 232 },
233 'TAP::Harness',
234 'one', 'two', 'three'
235 ]
236 ],
237 },
238
239 { name => 'Just color',
240 args => {
241 argv => [qw( one two three )],
242 color => 1,
243 },
244 expect => {
245 color => 1,
246 },
247 runlog => [
248 [ '_runtests',
27fc0087 249 { color => 1,
250 verbosity => 0,
251 show_count => 1,
b965d173 252 },
253 'TAP::Harness',
254 'one', 'two', 'three'
255 ]
256 ],
257 },
258
259 { name => 'Just directives',
260 args => {
261 argv => [qw( one two three )],
262 directives => 1,
263 },
264 expect => {
265 directives => 1,
266 },
267 runlog => [
268 [ '_runtests',
269 { directives => 1,
27fc0087 270 verbosity => 0,
271 show_count => 1,
b965d173 272 },
273 'TAP::Harness',
274 'one', 'two', 'three'
275 ]
276 ],
277 },
278 { name => 'Just exec',
279 args => {
280 argv => [qw( one two three )],
281 exec => 1,
282 },
283 expect => {
284 exec => 1,
285 },
286 runlog => [
287 [ '_runtests',
27fc0087 288 { exec => [1],
289 verbosity => 0,
290 show_count => 1,
b965d173 291 },
292 'TAP::Harness',
293 'one', 'two', 'three'
294 ]
295 ],
296 },
297 { name => 'Just failures',
298 args => {
299 argv => [qw( one two three )],
300 failures => 1,
301 },
302 expect => {
303 failures => 1,
304 },
305 runlog => [
306 [ '_runtests',
27fc0087 307 { failures => 1,
308 verbosity => 0,
309 show_count => 1,
b965d173 310 },
311 'TAP::Harness',
312 'one', 'two', 'three'
313 ]
314 ],
315 },
316
317 { name => 'Just formatter',
318 args => {
319 argv => [qw( one two three )],
320 formatter => 'TAP::Harness',
321 },
322 expect => {
323 formatter => 'TAP::Harness',
324 },
325 runlog => [
326 [ '_runtests',
327 { formatter_class => 'TAP::Harness',
27fc0087 328 verbosity => 0,
329 show_count => 1,
b965d173 330 },
331 'TAP::Harness',
332 'one', 'two', 'three'
333 ]
334 ],
335 },
336
337 { name => 'Just includes',
338 args => {
339 argv => [qw( one two three )],
340 includes => [qw( four five six )],
341 },
342 expect => {
343 includes => [qw( four five six )],
344 },
345 runlog => [
346 [ '_runtests',
347 { lib => mabs( [qw( four five six )] ),
27fc0087 348 verbosity => 0,
349 show_count => 1,
b965d173 350 },
351 'TAP::Harness',
352 'one', 'two', 'three'
353 ]
354 ],
355 },
356 { name => 'Just lib',
357 args => {
358 argv => [qw( one two three )],
359 lib => 1,
360 },
361 expect => {
362 lib => 1,
363 },
364 runlog => [
365 [ '_runtests',
366 { lib => mabs( ['lib'] ),
27fc0087 367 verbosity => 0,
368 show_count => 1,
b965d173 369 },
370 'TAP::Harness',
371 'one', 'two', 'three'
372 ]
373 ],
374 },
375 { name => 'Just merge',
376 args => {
377 argv => [qw( one two three )],
378 merge => 1,
379 },
380 expect => {
381 merge => 1,
382 },
383 runlog => [
384 [ '_runtests',
27fc0087 385 { merge => 1,
386 verbosity => 0,
387 show_count => 1,
b965d173 388 },
389 'TAP::Harness',
390 'one', 'two', 'three'
391 ]
392 ],
393 },
394 { name => 'Just parse',
395 args => {
396 argv => [qw( one two three )],
397 parse => 1,
398 },
399 expect => {
400 parse => 1,
401 },
402 runlog => [
403 [ '_runtests',
27fc0087 404 { errors => 1,
405 verbosity => 0,
406 show_count => 1,
b965d173 407 },
408 'TAP::Harness',
409 'one', 'two', 'three'
410 ]
411 ],
412 },
413 { name => 'Just quiet',
414 args => {
415 argv => [qw( one two three )],
416 quiet => 1,
417 },
418 expect => {
419 quiet => 1,
420 },
421 runlog => [
422 [ '_runtests',
27fc0087 423 { verbosity => -1,
424 show_count => 1,
b965d173 425 },
426 'TAP::Harness',
427 'one', 'two', 'three'
428 ]
429 ],
430 },
431 { name => 'Just really_quiet',
432 args => {
433 argv => [qw( one two three )],
434 really_quiet => 1,
435 },
436 expect => {
437 really_quiet => 1,
438 },
439 runlog => [
440 [ '_runtests',
27fc0087 441 { verbosity => -2,
442 show_count => 1,
b965d173 443 },
444 'TAP::Harness',
445 'one', 'two', 'three'
446 ]
447 ],
448 },
449 { name => 'Just recurse',
450 args => {
451 argv => [qw( one two three )],
452 recurse => 1,
453 },
454 expect => {
455 recurse => 1,
456 },
457 runlog => [
458 [ '_runtests',
27fc0087 459 { verbosity => 0,
460 show_count => 1,
461 },
b965d173 462 'TAP::Harness',
463 'one', 'two', 'three'
464 ]
465 ],
466 },
467 { name => 'Just reverse',
468 args => {
469 argv => [qw( one two three )],
470 backwards => 1,
471 },
472 expect => {
473 backwards => 1,
474 },
475 runlog => [
476 [ '_runtests',
27fc0087 477 { verbosity => 0,
478 show_count => 1,
479 },
b965d173 480 'TAP::Harness',
481 'three', 'two', 'one'
482 ]
483 ],
484 },
485
486 { name => 'Just shuffle',
487 args => {
488 argv => [qw( one two three )],
489 shuffle => 1,
490 },
491 expect => {
492 shuffle => 1,
493 },
494 runlog => [
495 [ '_runtests',
27fc0087 496 { verbosity => 0,
497 show_count => 1,
498 },
b965d173 499 'TAP::Harness',
500 'xxxone', 'xxxtwo',
501 'xxxthree'
502 ]
503 ],
504 },
505 { name => 'Just taint_fail',
506 args => {
507 argv => [qw( one two three )],
508 taint_fail => 1,
509 },
510 expect => {
511 taint_fail => 1,
512 },
513 runlog => [
514 [ '_runtests',
27fc0087 515 { switches => ['-T'],
516 verbosity => 0,
517 show_count => 1,
b965d173 518 },
519 'TAP::Harness',
520 'one', 'two', 'three'
521 ]
522 ],
523 },
524 { name => 'Just taint_warn',
525 args => {
526 argv => [qw( one two three )],
527 taint_warn => 1,
528 },
529 expect => {
530 taint_warn => 1,
531 },
532 runlog => [
533 [ '_runtests',
27fc0087 534 { switches => ['-t'],
535 verbosity => 0,
536 show_count => 1,
b965d173 537 },
538 'TAP::Harness',
539 'one', 'two', 'three'
540 ]
541 ],
542 },
543 { name => 'Just verbose',
544 args => {
545 argv => [qw( one two three )],
546 verbose => 1,
547 },
548 expect => {
549 verbose => 1,
550 },
551 runlog => [
552 [ '_runtests',
27fc0087 553 { verbosity => 1,
554 show_count => 1,
b965d173 555 },
556 'TAP::Harness',
557 'one', 'two', 'three'
558 ]
559 ],
560 },
561 { name => 'Just warnings_fail',
562 args => {
563 argv => [qw( one two three )],
564 warnings_fail => 1,
565 },
566 expect => {
567 warnings_fail => 1,
568 },
569 runlog => [
570 [ '_runtests',
27fc0087 571 { switches => ['-W'],
572 verbosity => 0,
573 show_count => 1,
b965d173 574 },
575 'TAP::Harness',
576 'one', 'two', 'three'
577 ]
578 ],
579 },
580 { name => 'Just warnings_warn',
581 args => {
582 argv => [qw( one two three )],
583 warnings_warn => 1,
584 },
585 expect => {
586 warnings_warn => 1,
587 },
588 runlog => [
589 [ '_runtests',
27fc0087 590 { switches => ['-w'],
591 verbosity => 0,
592 show_count => 1,
b965d173 593 },
594 'TAP::Harness',
595 'one', 'two', 'three'
596 ]
597 ],
598 },
599
600 # Command line parsing
601 { name => 'Switch -v',
602 args => {
603 argv => [qw( one two three )],
604 },
605 switches => [ '-v', $dummy_test ],
606 expect => {
607 verbose => 1,
608 },
609 runlog => [
610 [ '_runtests',
27fc0087 611 { verbosity => 1,
612 show_count => 1,
b965d173 613 },
614 'TAP::Harness',
615 $dummy_test
616 ]
617 ],
618 },
619
620 { name => 'Switch --verbose',
621 args => {
622 argv => [qw( one two three )],
623 },
624 switches => [ '--verbose', $dummy_test ],
625 expect => {
626 verbose => 1,
627 },
628 runlog => [
629 [ '_runtests',
27fc0087 630 { verbosity => 1,
631 show_count => 1,
b965d173 632 },
633 'TAP::Harness',
634 $dummy_test
635 ]
636 ],
637 },
638
639 { name => 'Switch -f',
640 args => {
641 argv => [qw( one two three )],
642 },
643 switches => [ '-f', $dummy_test ],
644 expect => { failures => 1 },
645 runlog => [
646 [ '_runtests',
27fc0087 647 { failures => 1,
648 verbosity => 0,
649 show_count => 1,
b965d173 650 },
651 'TAP::Harness',
652 $dummy_test
653 ]
654 ],
655 },
656
657 { name => 'Switch --failures',
658 args => {
659 argv => [qw( one two three )],
660 },
661 switches => [ '--failures', $dummy_test ],
662 expect => { failures => 1 },
663 runlog => [
664 [ '_runtests',
27fc0087 665 { failures => 1,
666 verbosity => 0,
667 show_count => 1,
b965d173 668 },
669 'TAP::Harness',
670 $dummy_test
671 ]
672 ],
673 },
674
675 { name => 'Switch -l',
676 args => {
677 argv => [qw( one two three )],
678 },
679 switches => [ '-l', $dummy_test ],
680 expect => { lib => 1 },
681 runlog => [
682 [ '_runtests',
683 { lib => mabs( ['lib'] ),
27fc0087 684 verbosity => 0,
685 show_count => 1,
b965d173 686 },
687 'TAP::Harness',
688 $dummy_test
689 ]
690 ],
691 },
692
693 { name => 'Switch --lib',
694 args => {
695 argv => [qw( one two three )],
696 },
697 switches => [ '--lib', $dummy_test ],
698 expect => { lib => 1 },
699 runlog => [
700 [ '_runtests',
701 { lib => mabs( ['lib'] ),
27fc0087 702 verbosity => 0,
703 show_count => 1,
b965d173 704 },
705 'TAP::Harness',
706 $dummy_test
707 ]
708 ],
709 },
710
711 { name => 'Switch -b',
712 args => {
713 argv => [qw( one two three )],
714 },
715 switches => [ '-b', $dummy_test ],
716 expect => { blib => 1 },
717 runlog => [
718 [ '_runtests',
719 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
27fc0087 720 verbosity => 0,
721 show_count => 1,
b965d173 722 },
723 'TAP::Harness',
724 $dummy_test
725 ]
726 ],
727 },
728
729 { name => 'Switch --blib',
730 args => {
731 argv => [qw( one two three )],
732 },
733 switches => [ '--blib', $dummy_test ],
734 expect => { blib => 1 },
735 runlog => [
736 [ '_runtests',
737 { lib => mabs( [ 'blib/lib', 'blib/arch' ] ),
27fc0087 738 verbosity => 0,
739 show_count => 1,
b965d173 740 },
741 'TAP::Harness',
742 $dummy_test
743 ]
744 ],
745 },
746
747 { name => 'Switch -s',
748 args => {
749 argv => [qw( one two three )],
750 },
751 switches => [ '-s', $dummy_test ],
752 expect => { shuffle => 1 },
753 runlog => [
754 [ '_runtests',
27fc0087 755 { verbosity => 0,
756 show_count => 1,
757 },
b965d173 758 'TAP::Harness',
759 "xxx$dummy_test"
760 ]
761 ],
762 },
763
764 { name => 'Switch --shuffle',
765 args => {
766 argv => [qw( one two three )],
767 },
768 switches => [ '--shuffle', $dummy_test ],
769 expect => { shuffle => 1 },
770 runlog => [
771 [ '_runtests',
27fc0087 772 { verbosity => 0,
773 show_count => 1,
774 },
b965d173 775 'TAP::Harness',
776 "xxx$dummy_test"
777 ]
778 ],
779 },
780
781 { name => 'Switch -c',
782 args => {
783 argv => [qw( one two three )],
784 },
785 switches => [ '-c', $dummy_test ],
786 expect => { color => 1 },
787 runlog => [
788 [ '_runtests',
27fc0087 789 { color => 1,
790 verbosity => 0,
791 show_count => 1,
b965d173 792 },
793 'TAP::Harness',
794 $dummy_test
795 ]
796 ],
797 },
798
799 { name => 'Switch -r',
800 args => {
801 argv => [qw( one two three )],
802 },
803 switches => [ '-r', $dummy_test ],
804 expect => { recurse => 1 },
805 runlog => [
806 [ '_runtests',
27fc0087 807 { verbosity => 0,
808 show_count => 1,
809 },
b965d173 810 'TAP::Harness',
811 $dummy_test
812 ]
813 ],
814 },
815
816 { name => 'Switch --recurse',
817 args => {
818 argv => [qw( one two three )],
819 },
820 switches => [ '--recurse', $dummy_test ],
821 expect => { recurse => 1 },
822 runlog => [
823 [ '_runtests',
27fc0087 824 { verbosity => 0,
825 show_count => 1,
826 },
b965d173 827 'TAP::Harness',
828 $dummy_test
829 ]
830 ],
831 },
832
833 { name => 'Switch --reverse',
834 args => {
835 argv => [qw( one two three )],
836 },
837 switches => [ '--reverse', @dummy_tests ],
838 expect => { backwards => 1 },
839 runlog => [
840 [ '_runtests',
27fc0087 841 { verbosity => 0,
842 show_count => 1,
843 },
b965d173 844 'TAP::Harness',
845 reverse @dummy_tests
846 ]
847 ],
848 },
849
850 { name => 'Switch -p',
851 args => {
852 argv => [qw( one two three )],
853 },
854 switches => [ '-p', $dummy_test ],
855 expect => {
856 parse => 1,
857 },
858 runlog => [
859 [ '_runtests',
27fc0087 860 { errors => 1,
861 verbosity => 0,
862 show_count => 1,
b965d173 863 },
864 'TAP::Harness',
865 $dummy_test
866 ]
867 ],
868 },
869
870 { name => 'Switch --parse',
871 args => {
872 argv => [qw( one two three )],
873 },
874 switches => [ '--parse', $dummy_test ],
875 expect => {
876 parse => 1,
877 },
878 runlog => [
879 [ '_runtests',
27fc0087 880 { errors => 1,
881 verbosity => 0,
882 show_count => 1,
b965d173 883 },
884 'TAP::Harness',
885 $dummy_test
886 ]
887 ],
888 },
889
890 { name => 'Switch -q',
891 args => {
892 argv => [qw( one two three )],
893 },
894 switches => [ '-q', $dummy_test ],
895 expect => { quiet => 1 },
896 runlog => [
897 [ '_runtests',
27fc0087 898 { verbosity => -1,
899 show_count => 1,
b965d173 900 },
901 'TAP::Harness',
902 $dummy_test
903 ]
904 ],
905 },
906
907 { name => 'Switch --quiet',
908 args => {
909 argv => [qw( one two three )],
910 },
911 switches => [ '--quiet', $dummy_test ],
912 expect => { quiet => 1 },
913 runlog => [
914 [ '_runtests',
27fc0087 915 { verbosity => -1,
916 show_count => 1,
b965d173 917 },
918 'TAP::Harness',
919 $dummy_test
920 ]
921 ],
922 },
923
924 { name => 'Switch -Q',
925 args => {
926 argv => [qw( one two three )],
927 },
928 switches => [ '-Q', $dummy_test ],
929 expect => { really_quiet => 1 },
930 runlog => [
931 [ '_runtests',
27fc0087 932 { verbosity => -2,
933 show_count => 1,
b965d173 934 },
935 'TAP::Harness',
936 $dummy_test
937 ]
938 ],
939 },
940
941 { name => 'Switch --QUIET',
942 args => {
943 argv => [qw( one two three )],
944 },
945 switches => [ '--QUIET', $dummy_test ],
946 expect => { really_quiet => 1 },
947 runlog => [
948 [ '_runtests',
27fc0087 949 { verbosity => -2,
950 show_count => 1,
b965d173 951 },
952 'TAP::Harness',
953 $dummy_test
954 ]
955 ],
956 },
957
958 { name => 'Switch -m',
959 args => {
960 argv => [qw( one two three )],
961 },
962 switches => [ '-m', $dummy_test ],
963 expect => { merge => 1 },
964 runlog => [
965 [ '_runtests',
27fc0087 966 { merge => 1,
967 verbosity => 0,
968 show_count => 1,
b965d173 969 },
970 'TAP::Harness',
971 $dummy_test
972 ]
973 ],
974 },
975
976 { name => 'Switch --merge',
977 args => {
978 argv => [qw( one two three )],
979 },
980 switches => [ '--merge', $dummy_test ],
981 expect => { merge => 1 },
982 runlog => [
983 [ '_runtests',
27fc0087 984 { merge => 1,
985 verbosity => 0,
986 show_count => 1,
b965d173 987 },
988 'TAP::Harness',
989 $dummy_test
990 ]
991 ],
992 },
993
994 { name => 'Switch --directives',
995 args => {
996 argv => [qw( one two three )],
997 },
998 switches => [ '--directives', $dummy_test ],
999 expect => { directives => 1 },
1000 runlog => [
1001 [ '_runtests',
1002 { directives => 1,
27fc0087 1003 verbosity => 0,
1004 show_count => 1,
b965d173 1005 },
1006 'TAP::Harness',
1007 $dummy_test
1008 ]
1009 ],
1010 },
1011
a39e16d8 1012 # .proverc
1013 { name => 'Empty exec in .proverc',
1014 args => {
1015 argv => [qw( one two three )],
1016 },
1017 proverc => $ENV{PERL_CORE} ? '../ext/Test-Harness/t/proverc/emptyexec' : 't/proverc/emptyexec',
1018 switches => [$dummy_test],
1019 expect => { exec => '' },
1020 runlog => [
1021 [ '_runtests',
1022 { exec => [],
1023 verbosity => 0,
1024 show_count => 1,
1025 },
1026 'TAP::Harness',
1027 $dummy_test
1028 ]
1029 ],
1030 },
1031
b965d173 1032 # Executing one word (why would it be a -s though?)
1033 { name => 'Switch --exec -s',
1034 args => {
1035 argv => [qw( one two three )],
1036 },
1037 switches => [ '--exec', '-s', $dummy_test ],
1038 expect => { exec => '-s' },
1039 runlog => [
27fc0087 1040 [ '_runtests',
1041 { exec => ['-s'],
1042 verbosity => 0,
1043 show_count => 1,
1044 },
b965d173 1045 'TAP::Harness',
1046 $dummy_test
1047 ]
1048 ],
1049 },
1050
1051 # multi-part exec
1052 { name => 'Switch --exec "/foo/bar/perl -Ilib"',
1053 args => {
1054 argv => [qw( one two three )],
1055 },
1056 switches => [ '--exec', '/foo/bar/perl -Ilib', $dummy_test ],
1057 expect => { exec => '/foo/bar/perl -Ilib' },
1058 runlog => [
1059 [ '_runtests',
27fc0087 1060 { exec => [qw(/foo/bar/perl -Ilib)],
1061 verbosity => 0,
1062 show_count => 1,
b965d173 1063 },
1064 'TAP::Harness',
1065 $dummy_test
1066 ]
1067 ],
1068 },
1069
1070 # null exec (run tests as compiled binaries)
1071 { name => 'Switch --exec ""',
1072 switches => [ '--exec', '', $dummy_test ],
1073 expect => {
1074 exec => # ick, must workaround the || default bit with a sub
1075 sub { my $val = shift; defined($val) and !length($val) }
1076 },
1077 runlog => [
1078 [ '_runtests',
27fc0087 1079 { exec => [],
1080 verbosity => 0,
1081 show_count => 1,
1082 },
b965d173 1083 'TAP::Harness',
1084 $dummy_test
1085 ]
1086 ],
1087 },
1088
1089 # Plugins
1090 { name => 'Load plugin',
1091 switches => [ '-P', 'Dummy', $dummy_test ],
1092 args => {
1093 argv => [qw( one two three )],
1094 },
1095 expect => {
1096 plugins => ['Dummy'],
1097 },
1098 extra => sub {
1099 my @loaded = get_import_log();
1100 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1101 "Plugin loaded OK";
1102 },
1103 plan => 1,
1104 runlog => [
1105 [ '_runtests',
27fc0087 1106 { verbosity => 0,
1107 show_count => 1,
1108 },
b965d173 1109 'TAP::Harness',
1110 $dummy_test
1111 ]
1112 ],
1113 },
1114
1115 { name => 'Load plugin (args)',
1116 switches => [ '-P', 'Dummy=cracking,cheese,gromit', $dummy_test ],
1117 args => {
1118 argv => [qw( one two three )],
1119 },
1120 expect => {
1121 plugins => ['Dummy'],
1122 },
1123 extra => sub {
1124 my @loaded = get_import_log();
1125 is_deeply \@loaded,
1126 [ [ 'App::Prove::Plugin::Dummy', 'cracking', 'cheese',
1127 'gromit'
1128 ]
1129 ],
1130 "Plugin loaded OK";
1131 },
1132 plan => 1,
1133 runlog => [
1134 [ '_runtests',
27fc0087 1135 { verbosity => 0,
1136 show_count => 1,
1137 },
b965d173 1138 'TAP::Harness',
1139 $dummy_test
1140 ]
1141 ],
1142 },
1143
1144 { name => 'Load plugin (explicit path)',
1145 switches => [ '-P', 'App::Prove::Plugin::Dummy', $dummy_test ],
1146 args => {
1147 argv => [qw( one two three )],
1148 },
1149 expect => {
1150 plugins => ['Dummy'],
1151 },
1152 extra => sub {
1153 my @loaded = get_import_log();
1154 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1155 "Plugin loaded OK";
1156 },
1157 plan => 1,
1158 runlog => [
1159 [ '_runtests',
27fc0087 1160 { verbosity => 0,
1161 show_count => 1,
bdaf8c65 1162 },
1163 'TAP::Harness',
1164 $dummy_test
1165 ]
1166 ],
1167 },
1168
1169 { name => 'Load plugin (args + call load method)',
1170 switches => [ '-P', 'Dummy2=fou,du,fafa', $dummy_test ],
1171 args => {
1172 argv => [qw( one two three )],
1173 },
1174 expect => {
1175 plugins => ['Dummy2'],
1176 },
1177 extra => sub {
1178 my @import = get_import_log();
1179 is_deeply \@import,
1180 [ [ 'App::Prove::Plugin::Dummy2', 'fou', 'du', 'fafa' ] ],
1181 "Plugin loaded OK";
1182
1183 my @loaded = get_plugin_load_log();
1184 is( scalar @loaded, 1, 'Plugin->load called OK' );
1185 my ( $plugin_class, $args ) = @{ shift @loaded };
1186 is( $plugin_class, 'App::Prove::Plugin::Dummy2',
1187 'plugin_class passed'
1188 );
1189 isa_ok(
1190 $args->{app_prove}, 'App::Prove',
1191 'app_prove object passed'
1192 );
1193 is_deeply(
1194 $args->{args}, [qw( fou du fafa )],
1195 'expected args passed'
1196 );
1197 },
1198 plan => 5,
1199 runlog => [
1200 [ '_runtests',
1201 { verbosity => 0,
1202 show_count => 1,
27fc0087 1203 },
b965d173 1204 'TAP::Harness',
1205 $dummy_test
1206 ]
1207 ],
1208 },
1209
1210 { name => 'Load module',
1211 switches => [ '-M', 'App::Prove::Plugin::Dummy', $dummy_test ],
1212 args => {
1213 argv => [qw( one two three )],
1214 },
1215 expect => {
1216 plugins => ['Dummy'],
1217 },
1218 extra => sub {
1219 my @loaded = get_import_log();
1220 is_deeply \@loaded, [ ['App::Prove::Plugin::Dummy'] ],
1221 "Plugin loaded OK";
1222 },
1223 plan => 1,
1224 runlog => [
1225 [ '_runtests',
27fc0087 1226 { verbosity => 0,
1227 show_count => 1,
1228 },
b965d173 1229 'TAP::Harness',
1230 $dummy_test
1231 ]
1232 ],
1233 },
1234
1235 # TODO
1236 # Hmm, that doesn't work...
1237 # { name => 'Switch -h',
1238 # args => {
1239 # argv => [qw( one two three )],
1240 # },
1241 # switches => [ '-h', $dummy_test ],
1242 # expect => {},
1243 # runlog => [
1244 # [ '_runtests',
1245 # {},
1246 # 'TAP::Harness',
1247 # $dummy_test
1248 # ]
1249 # ],
1250 # },
1251
1252 # { name => 'Switch --help',
1253 # args => {
1254 # argv => [qw( one two three )],
1255 # },
1256 # switches => [ '--help', $dummy_test ],
1257 # expect => {},
1258 # runlog => [
1259 # [ {},
1260 # 'TAP::Harness',
1261 # $dummy_test
1262 # ]
1263 # ],
1264 # },
1265 # { name => 'Switch -?',
1266 # args => {
1267 # argv => [qw( one two three )],
1268 # },
1269 # switches => [ '-?', $dummy_test ],
1270 # expect => {},
1271 # runlog => [
1272 # [ {},
1273 # 'TAP::Harness',
1274 # $dummy_test
1275 # ]
1276 # ],
1277 # },
1278 #
1279 # { name => 'Switch -H',
1280 # args => {
1281 # argv => [qw( one two three )],
1282 # },
1283 # switches => [ '-H', $dummy_test ],
1284 # expect => {},
1285 # runlog => [
1286 # [ {},
1287 # 'TAP::Harness',
1288 # $dummy_test
1289 # ]
1290 # ],
1291 # },
1292 #
1293 # { name => 'Switch --man',
1294 # args => {
1295 # argv => [qw( one two three )],
1296 # },
1297 # switches => [ '--man', $dummy_test ],
1298 # expect => {},
1299 # runlog => [
1300 # [ {},
1301 # 'TAP::Harness',
1302 # $dummy_test
1303 # ]
1304 # ],
1305 # },
1306 #
1307 # { name => 'Switch -V',
1308 # args => {
1309 # argv => [qw( one two three )],
1310 # },
1311 # switches => [ '-V', $dummy_test ],
1312 # expect => {},
1313 # runlog => [
1314 # [ {},
1315 # 'TAP::Harness',
1316 # $dummy_test
1317 # ]
1318 # ],
1319 # },
1320 #
1321 # { name => 'Switch --version',
1322 # args => {
1323 # argv => [qw( one two three )],
1324 # },
1325 # switches => [ '--version', $dummy_test ],
1326 # expect => {},
1327 # runlog => [
1328 # [ {},
1329 # 'TAP::Harness',
1330 # $dummy_test
1331 # ]
1332 # ],
1333 # },
1334 #
1335 # { name => 'Switch --color!',
1336 # args => {
1337 # argv => [qw( one two three )],
1338 # },
1339 # switches => [ '--color!', $dummy_test ],
1340 # expect => {},
1341 # runlog => [
1342 # [ {},
1343 # 'TAP::Harness',
1344 # $dummy_test
1345 # ]
1346 # ],
1347 # },
1348 #
1349 { name => 'Switch -I=s@',
1350 args => {
1351 argv => [qw( one two three )],
1352 },
1353 switches => [ '-Ilib', $dummy_test ],
1354 expect => {
1355 includes => sub {
1356 my ( $val, $attr ) = @_;
1357 return
1358 'ARRAY' eq ref $val
1359 && 1 == @$val
1360 && $val->[0] =~ /lib$/;
1361 },
1362 },
1363 },
1364
1365 # { name => 'Switch -a',
1366 # args => {
1367 # argv => [qw( one two three )],
1368 # },
1369 # switches => [ '-a', $dummy_test ],
1370 # expect => {},
1371 # runlog => [
1372 # [ {},
1373 # 'TAP::Harness',
1374 # $dummy_test
1375 # ]
1376 # ],
1377 # },
1378 #
1379 # { name => 'Switch --archive=-s',
1380 # args => {
1381 # argv => [qw( one two three )],
1382 # },
1383 # switches => [ '--archive=-s', $dummy_test ],
1384 # expect => {},
1385 # runlog => [
1386 # [ {},
1387 # 'TAP::Harness',
1388 # $dummy_test
1389 # ]
1390 # ],
1391 # },
1392 #
1393 # { name => 'Switch --formatter=-s',
1394 # args => {
1395 # argv => [qw( one two three )],
1396 # },
1397 # switches => [ '--formatter=-s', $dummy_test ],
1398 # expect => {},
1399 # runlog => [
1400 # [ {},
1401 # 'TAP::Harness',
1402 # $dummy_test
1403 # ]
1404 # ],
1405 # },
1406 #
1407 # { name => 'Switch -e',
1408 # args => {
1409 # argv => [qw( one two three )],
1410 # },
1411 # switches => [ '-e', $dummy_test ],
1412 # expect => {},
1413 # runlog => [
1414 # [ {},
1415 # 'TAP::Harness',
1416 # $dummy_test
1417 # ]
1418 # ],
1419 # },
1420 #
1421 # { name => 'Switch --harness=-s',
1422 # args => {
1423 # argv => [qw( one two three )],
1424 # },
1425 # switches => [ '--harness=-s', $dummy_test ],
1426 # expect => {},
1427 # runlog => [
1428 # [ {},
1429 # 'TAP::Harness',
1430 # $dummy_test
1431 # ]
1432 # ],
1433 # },
1434
1435 );
1436
1437 # END SCHEDULE
1438 ########################################################################
1439
1440 my $extra_plan = 0;
1441 for my $test (@SCHEDULE) {
1442 $extra_plan += $test->{plan} || 0;
1443 $extra_plan += 2 if $test->{runlog};
1444 $extra_plan += 1 if $test->{switches};
1445 }
1446
1447 plan tests => @SCHEDULE * ( 3 + @ATTR ) + $extra_plan;
1448} # END PLAN
1449
1450# ACTUAL TEST
1451for my $test (@SCHEDULE) {
1452 my $name = $test->{name};
1453 my $class = $test->{class} || 'FakeProve';
1454
9965363e 1455 local $ENV{HARNESS_TIMER};
1456
b965d173 1457 ok my $app = $class->new( exists $test->{args} ? $test->{args} : () ),
1458 "$name: App::Prove created OK";
1459
1460 isa_ok $app, 'App::Prove';
1461 isa_ok $app, $class;
1462
1463 # Optionally parse command args
1464 if ( my $switches = $test->{switches} ) {
a39e16d8 1465 if ( my $proverc = $test->{proverc} ) {
1466 $app->add_rc_file( File::Spec->catfile( split /\//, $proverc ) );
1467 }
b965d173 1468 eval { $app->process_args( '--norc', @$switches ) };
1469 if ( my $err_pattern = $test->{parse_error} ) {
1470 like $@, $err_pattern, "$name: expected parse error";
1471 }
1472 else {
1473 ok !$@, "$name: no parse error";
1474 }
1475 }
1476
1477 my $expect = $test->{expect} || {};
1478 for my $attr ( sort @ATTR ) {
a39e16d8 1479 my $val = $app->$attr();
1480 my $assertion
1481 = exists $expect->{$attr}
1482 ? $expect->{$attr}
1483 : $DEFAULT_ASSERTION{$attr};
1484 my $is_ok = undef;
b965d173 1485
1486 if ( 'CODE' eq ref $assertion ) {
1487 $is_ok = ok $assertion->( $val, $attr ),
1488 "$name: $attr has the expected value";
1489 }
1490 elsif ( 'Regexp' eq ref $assertion ) {
1491 $is_ok = like $val, $assertion, "$name: $attr matches $assertion";
1492 }
1493 else {
1494 $is_ok = is_deeply $val, $assertion,
1495 "$name: $attr has the expected value";
1496 }
1497
1498 unless ($is_ok) {
1499 diag "got $val for $attr";
1500 }
1501 }
1502
1503 if ( my $runlog = $test->{runlog} ) {
1504 eval { $app->run };
1505 if ( my $err_pattern = $test->{run_error} ) {
1506 like $@, $err_pattern, "$name: expected error OK";
1507 pass;
1508 pass for 1 .. $test->{plan};
1509 }
1510 else {
1511 unless ( ok !$@, "$name: no error OK" ) {
1512 diag "$name: error: $@\n";
1513 }
1514
1515 my $gotlog = [ $app->get_log ];
1516
1517 if ( my $extra = $test->{extra} ) {
1518 $extra->($gotlog);
1519 }
1520
1521 unless (
1522 is_deeply $gotlog, $runlog,
1523 "$name: run results match"
1524 )
1525 {
1526 use Data::Dumper;
1527 diag Dumper( { wanted => $runlog, got => $gotlog } );
1528 }
1529 }
1530 }
1531}