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