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