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