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