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