Commit | Line | Data |
b965d173 |
1 | #!/usr/bin/perl -w |
2 | |
3 | BEGIN { |
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 | |
13 | use strict; |
b965d173 |
14 | |
15 | use Test::More; |
16 | use File::Spec; |
17 | |
18 | use App::Prove; |
19 | |
20 | package FakeProve; |
21 | use vars qw( @ISA ); |
22 | |
23 | @ISA = qw( App::Prove ); |
24 | |
25 | sub new { |
26 | my $class = shift; |
27 | my $self = $class->SUPER::new(@_); |
28 | $self->{_log} = []; |
29 | return $self; |
30 | } |
31 | |
32 | sub _color_default {0} |
33 | |
34 | sub _runtests { |
35 | my $self = shift; |
36 | push @{ $self->{_log} }, [ '_runtests', @_ ]; |
37 | } |
38 | |
39 | sub get_log { |
40 | my $self = shift; |
41 | my @log = @{ $self->{_log} }; |
42 | $self->{_log} = []; |
43 | return @log; |
44 | } |
45 | |
46 | sub _shuffle { |
47 | my $self = shift; |
48 | s/^/xxx/ for @_; |
49 | } |
50 | |
51 | package main; |
52 | |
53 | sub 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 | |
78 | my ( @ATTR, %DEFAULT_ASSERTION, @SCHEDULE ); |
79 | |
80 | # see the "ACTUAL TEST" section at the bottom |
81 | |
82 | BEGIN { # 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 |
1451 | for 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 | } |