ext/Test/Harness/t/prove.t

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