lib/Test/Harness/t/strap-analyze.t

   1 #!/usr/bin/perl -w
   2
   3 BEGIN {
   4     if( $ENV{PERL_CORE} ) {
   5         chdir 't';
   6         @INC = ('../lib', 'lib');
   7     }
   8     else {
   9         unshift @INC, 't/lib';
  10     }
  11 }
  12
  13 use strict;
  14 use Test::More;
  15 use File::Spec;
  16
  17 my $Curdir = File::Spec->curdir;
  18 my $SAMPLE_TESTS = $ENV{PERL_CORE}
  19                     ? File::Spec->catdir($Curdir, 'lib', 'sample-tests')
  20                     : File::Spec->catdir($Curdir, 't',   'sample-tests');
  21
  22
  23 my $IsMacPerl = $^O eq 'MacOS';
  24 my $IsVMS     = $^O eq 'VMS';
  25
  26 # VMS uses native, not POSIX, exit codes.
  27 my $die_exit = $IsVMS ? 44 : 1;
  28
  29 # We can only predict that the wait status should be zero or not.
  30 my $wait_non_zero = 1;
  31
  32 my %samples = (
  33     bignum => {
  34         bonus => 0,
  35         details => [
  36             {
  37                 actual_ok => 1,
  38                 ok => 1
  39             },
  40             {
  41                 actual_ok => 1,
  42                 ok => 1
  43             }
  44         ],
  45         'exit' => 0,
  46         max => 2,
  47         ok => 4,
  48         passing => 0,
  49         seen => 4,
  50         skip => 0,
  51         todo => 0,
  52         'wait' => 0
  53     },
  54     combined => {
  55         bonus => 1,
  56         details => [
  57             {
  58                 actual_ok => 1,
  59                 ok => 1
  60             },
  61             {
  62                 actual_ok => 1,
  63                 name => "basset hounds got long ears",
  64                 ok => 1
  65             },
  66             {
  67                 actual_ok => 0,
  68                 name => "all hell broke lose",
  69                 ok => 0
  70             },
  71             {
  72                 actual_ok => 1,
  73                 ok => 1,
  74                 type => "todo"
  75             },
  76             {
  77                 actual_ok => 1,
  78                 ok => 1
  79             },
  80             {
  81                 actual_ok => 1,
  82                 ok => 1
  83             },
  84             {
  85                 actual_ok => 1,
  86                 ok => 1,
  87                 reason => "contract negociations",
  88                 type => "skip"
  89             },
  90             {
  91                 actual_ok => 1,
  92                 ok => 1
  93             },
  94             {
  95                 actual_ok => 0,
  96                 ok => 0
  97             },
  98             {
  99                 actual_ok => 0,
 100                 ok => 1,
 101                 type => "todo"
 102             }
 103         ],
 104         'exit' => 0,
 105         max => 10,
 106         ok => 8,
 107         passing => 0,
 108         seen => 10,
 109         skip => 1,
 110         todo => 2,
 111         'wait' => 0
 112     },
 113     descriptive => {
 114         bonus => 0,
 115         details => [
 116             {
 117                 actual_ok => 1,
 118                 name => "Interlock activated",
 119                 ok => 1
 120             },
 121             {
 122                 actual_ok => 1,
 123                 name => "Megathrusters are go",
 124                 ok => 1
 125             },
 126             {
 127                 actual_ok => 1,
 128                 name => "Head formed",
 129                 ok => 1
 130             },
 131             {
 132                 actual_ok => 1,
 133                 name => "Blazing sword formed",
 134                 ok => 1
 135             },
 136             {
 137                 actual_ok => 1,
 138                 name => "Robeast destroyed",
 139                 ok => 1
 140             }
 141         ],
 142         'exit' => 0,
 143         max => 5,
 144         ok => 5,
 145         passing => 1,
 146         seen => 5,
 147         skip => 0,
 148         todo => 0,
 149         'wait' => 0
 150     },
 151     'die' => {
 152         bonus => 0,
 153         details => [],
 154         'exit' => $die_exit,
 155         max => 0,
 156         ok => 0,
 157         passing => 0,
 158         seen => 0,
 159         skip => 0,
 160         todo => 0,
 161         'wait' => $wait_non_zero
 162     },
 163     die_head_end => {
 164         bonus => 0,
 165         details => [
 166             ({
 167                 actual_ok => 1,
 168                 ok => 1
 169             }) x 4,
 170         ],
 171         'exit' => $die_exit,
 172         max => 0,
 173         ok => 4,
 174         passing => 0,
 175         seen => 4,
 176         skip => 0,
 177         todo => 0,
 178         'wait' => $wait_non_zero
 179     },
 180     die_last_minute => {
 181         bonus => 0,
 182         details => [
 183             ({
 184                 actual_ok => 1,
 185                 ok => 1
 186             }) x 4,
 187         ],
 188         'exit' => $die_exit,
 189         max => 4,
 190         ok => 4,
 191         passing => 0,
 192         seen => 4,
 193         skip => 0,
 194         todo => 0,
 195         'wait' => $wait_non_zero
 196     },
 197     duplicates => {
 198         bonus => 0,
 199         details => [
 200             ({
 201                 actual_ok => 1,
 202                 ok => 1
 203             }) x 10,
 204         ],
 205         'exit' => 0,
 206         max => 10,
 207         ok => 11,
 208         passing => 0,
 209         seen => 11,
 210         skip => 0,
 211         todo => 0,
 212         'wait' => 0
 213     },
 214     head_end => {
 215         bonus => 0,
 216         details => [
 217             ({
 218                 actual_ok => 1,
 219                 ok => 1
 220             }) x 3,
 221             {
 222                 actual_ok => 1,
 223                 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
 224                 ok => 1
 225             }
 226         ],
 227         'exit' => 0,
 228         max => 4,
 229         ok => 4,
 230         passing => 1,
 231         seen => 4,
 232         skip => 0,
 233         todo => 0,
 234         'wait' => 0
 235     },
 236     head_fail => {
 237         bonus => 0,
 238         details => [
 239             {
 240                 actual_ok => 1,
 241                 ok => 1
 242             },
 243             {
 244                 actual_ok => 0,
 245                 ok => 0
 246             },
 247             {
 248                 actual_ok => 1,
 249                 ok => 1
 250             },
 251             {
 252                 actual_ok => 1,
 253                 diagnostics => "comment\nmore ignored stuff\nand yet more\n",
 254                 ok => 1
 255             }
 256         ],
 257         'exit' => 0,
 258         max => 4,
 259         ok => 3,
 260         passing => 0,
 261         seen => 4,
 262         skip => 0,
 263         todo => 0,
 264         'wait' => 0
 265     },
 266     lone_not_bug => {
 267         bonus => 0,
 268         details => [
 269             ({
 270                 actual_ok => 1,
 271                 ok => 1
 272             }) x 4,
 273         ],
 274         'exit' => 0,
 275         max => 4,
 276         ok => 4,
 277         passing => 1,
 278         seen => 4,
 279         skip => 0,
 280         todo => 0,
 281         'wait' => 0
 282     },
 283     no_output => {
 284         bonus => 0,
 285         details => [],
 286         'exit' => 0,
 287         max => 0,
 288         ok => 0,
 289         passing => 0,
 290         seen => 0,
 291         skip => 0,
 292         todo => 0,
 293         'wait' => 0
 294     },
 295     shbang_misparse => {
 296         bonus => 0,
 297         details => [
 298             ({
 299                 actual_ok => 1,
 300                 ok => 1
 301             }) x 2,
 302         ],
 303         'exit' => 0,
 304         max => 2,
 305         ok => 2,
 306         passing => 1,
 307         seen => 2,
 308         skip => 0,
 309         todo => 0,
 310         'wait' => 0
 311     },
 312     simple => {
 313         bonus => 0,
 314         details => [
 315             ({
 316                 actual_ok => 1,
 317                 ok => 1
 318             }) x 5,
 319         ],
 320         'exit' => 0,
 321         max => 5,
 322         ok => 5,
 323         passing => 1,
 324         seen => 5,
 325         skip => 0,
 326         todo => 0,
 327         'wait' => 0
 328     },
 329     simple_fail => {
 330         bonus => 0,
 331         details => [
 332             {
 333                 actual_ok => 1,
 334                 ok => 1
 335             },
 336             {
 337                 actual_ok => 0,
 338                 ok => 0
 339             },
 340             {
 341                 actual_ok => 1,
 342                 ok => 1
 343             },
 344             {
 345                 actual_ok => 1,
 346                 ok => 1
 347             },
 348             {
 349                 actual_ok => 0,
 350                 ok => 0
 351             }
 352         ],
 353         'exit' => 0,
 354         max => 5,
 355         ok => 3,
 356         passing => 0,
 357         seen => 5,
 358         skip => 0,
 359         todo => 0,
 360         'wait' => 0
 361     },
 362     skip => {
 363         bonus => 0,
 364         details => [
 365             {
 366                 actual_ok => 1,
 367                 ok => 1
 368             },
 369             {
 370                 actual_ok => 1,
 371                 ok => 1,
 372                 reason => "rain delay",
 373                 type => "skip"
 374             },
 375             ({
 376                 actual_ok => 1,
 377                 ok => 1
 378             }) x 3,
 379         ],
 380         'exit' => 0,
 381         max => 5,
 382         ok => 5,
 383         passing => 1,
 384         seen => 5,
 385         skip => 1,
 386         todo => 0,
 387         'wait' => 0
 388     },
 389     skip_nomsg => {
 390         bonus => 0,
 391         details => [
 392             {
 393                 actual_ok => 1,
 394                 ok => 1,
 395                 reason => "",
 396                 type => "skip"
 397             }
 398         ],
 399         'exit' => 0,
 400         max => 1,
 401         ok => 1,
 402         passing => 1,
 403         seen => 1,
 404         skip => 1,
 405         todo => 0,
 406         'wait' => 0
 407     },
 408     skipall => {
 409         bonus => 0,
 410         details => [],
 411         'exit' => 0,
 412         max => 0,
 413         ok => 0,
 414         passing => 1,
 415         seen => 0,
 416         skip => 0,
 417         skip_all => "rope",
 418         todo => 0,
 419         'wait' => 0
 420     },
 421     skipall_nomsg => {
 422         bonus => 0,
 423         details => [],
 424         'exit' => 0,
 425         max => 0,
 426         ok => 0,
 427         passing => 1,
 428         seen => 0,
 429         skip => 0,
 430         skip_all => "",
 431         todo => 0,
 432         'wait' => 0
 433     },
 434     taint => {
 435         bonus => 0,
 436         details => [
 437             {
 438                 actual_ok => 1,
 439                 name => "-T honored",
 440                 ok => 1
 441             }
 442         ],
 443         'exit' => 0,
 444         max => 1,
 445         ok => 1,
 446         passing => 1,
 447         seen => 1,
 448         skip => 0,
 449         todo => 0,
 450         'wait' => 0
 451     },
 452     todo => {
 453         bonus => 1,
 454         details => [
 455             {
 456                 actual_ok => 1,
 457                 ok => 1
 458             },
 459             {
 460                 actual_ok => 1,
 461                 ok => 1,
 462                 type => "todo"
 463             },
 464             {
 465                 actual_ok => 0,
 466                 ok => 1,
 467                 type => "todo"
 468             },
 469             ({
 470                 actual_ok => 1,
 471                 ok => 1
 472             }) x 2,
 473         ],
 474         'exit' => 0,
 475         max => 5,
 476         ok => 5,
 477         passing => 1,
 478         seen => 5,
 479         skip => 0,
 480         todo => 2,
 481         'wait' => 0
 482     },
 483     vms_nit => {
 484         bonus => 0,
 485         details => [
 486             {
 487                 actual_ok => 0,
 488                 ok => 0
 489             },
 490             {
 491                 actual_ok => 1,
 492                 ok => 1
 493             }
 494         ],
 495         'exit' => 0,
 496         max => 2,
 497         ok => 1,
 498         passing => 0,
 499         seen => 2,
 500         skip => 0,
 501         todo => 0,
 502         'wait' => 0
 503     },
 504     with_comments => {
 505         bonus => 2,
 506         details => [
 507             {
 508                 actual_ok => 0,
 509                 diagnostics => "Failed test 1 in t/todo.t at line 9 *TODO*\n",
 510                 ok => 1,
 511                 type => "todo"
 512             },
 513             {
 514                 actual_ok => 1,
 515                 ok => 1,
 516                 reason => "at line 10 TODO?!)",
 517                 type => "todo"
 518             },
 519             {
 520                 actual_ok => 1,
 521                 ok => 1
 522             },
 523             {
 524                 actual_ok => 0,
 525                 diagnostics => "Test 4 got: '0' (t/todo.t at line 12 *TODO*)\n  Expected: '1' (need more tuits)\n",
 526                 ok => 1,
 527                 type => "todo"
 528             },
 529             {
 530                 actual_ok => 1,
 531                 diagnostics => "woo\n",
 532                 ok => 1,
 533                 reason => "at line 13 TODO?!)",
 534                 type => "todo"
 535             }
 536         ],
 537         'exit' => 0,
 538         max => 5,
 539         ok => 5,
 540         passing => 1,
 541         seen => 5,
 542         skip => 0,
 543         todo => 4,
 544         'wait' => 0
 545     },
 546 );
 547 plan tests => (keys(%samples) * 5) + 3;
 548
 549 use Test::Harness::Straps;
 550 my @_INC = map { qq{"-I$_"} } @INC;
 551 $Test::Harness::Switches = "@_INC -Mstrict";
 552
 553 $SIG{__WARN__} = sub {
 554     warn @_ unless $_[0] =~ /^Enormous test number/ ||
 555                    $_[0] =~ /^Can't detailize/
 556 };
 557
 558 for my $test ( sort keys %samples ) {
 559     print "# Working on $test\n";
 560     my $expect = $samples{$test};
 561
 562     for my $n ( 0..$#{$expect->{details}} ) {
 563         for my $field ( qw( type name reason ) ) {
 564             $expect->{details}[$n]{$field} = '' unless exists $expect->{details}[$n]{$field};
 565         }
 566     }
 567
 568     my $test_path = File::Spec->catfile($SAMPLE_TESTS, $test);
 569     my $strap = Test::Harness::Straps->new;
 570     isa_ok( $strap, 'Test::Harness::Straps' );
 571     my %results = $strap->analyze_file($test_path);
 572
 573     is_deeply($results{details}, $expect->{details}, qq{details of "$test"} );
 574
 575     delete $expect->{details};
 576     delete $results{details};
 577
 578     SKIP: {
 579         skip '$? unreliable in MacPerl', 2 if $IsMacPerl;
 580
 581         # We can only check if it's zero or non-zero.
 582         is( !!$results{'wait'}, !!$expect->{'wait'}, 'wait status' );
 583         delete $results{'wait'};
 584         delete $expect->{'wait'};
 585
 586         # Have to check the exit status seperately so we can skip it
 587         # in MacPerl.
 588         is( $results{'exit'}, $expect->{'exit'} );
 589         delete $results{'exit'};
 590         delete $expect->{'exit'};
 591     }
 592
 593     is_deeply(\%results, $expect, qq{ the rest of "$test"} );
 594 } # for %samples
 595
 596 NON_EXISTENT_FILE: {
 597     my $strap = Test::Harness::Straps->new;
 598     isa_ok( $strap, 'Test::Harness::Straps' );
 599     ok( !$strap->analyze_file('I_dont_exist') );
 600     is( $strap->{error}, "I_dont_exist does not exist" );
 601 }