1#!/usr/bin/perl -w 2 3BEGIN { 4 unshift @INC, 't/lib'; 5} 6 7use strict; 8use warnings; 9use Config; 10 11# use lib 't/lib'; 12 13use Test::More; 14use File::Spec; 15use Test::Harness qw(execute_tests); 16 17# unset this global when self-testing ('testcover' and etc issue) 18local $ENV{HARNESS_PERL_SWITCHES}; 19 20my $TEST_DIR = 't/sample-tests'; 21my $NoTaintSupport = exists($Config{taint_support}) && !$Config{taint_support}; 22 23my @test_list = qw(descriptive die die_head_end die_last_minute duplicates 24 head_end head_fail inc_taint junk_before_plan lone_not_bug 25 no_nums no_output schwern sequence_misparse shbang_misparse 26 simple simple_fail skip skip_nomsg skipall skipall_nomsg 27 stdout_stderr taint todo_inline 28 todo_misparse too_many vms_nit 29 ); 30 31if ($NoTaintSupport) { 32 @test_list = grep { $_ !~ /taint/ && $_ ne 'shbang_misparse' } @test_list; 33} 34 35{ 36 37 # if the harness wants to save the resulting TAP we shouldn't 38 # do it for our internal calls 39 local $ENV{PERL_TEST_HARNESS_DUMP_TAP} = 0; 40 41 my $PER_LOOP = 4; 42 43 my $results = { 44 'descriptive' => { 45 'failed' => {}, 46 'todo' => {}, 47 'totals' => { 48 'bad' => 0, 49 'bonus' => 0, 50 'files' => 1, 51 'good' => 1, 52 'max' => 5, 53 'ok' => 5, 54 'skipped' => 0, 55 'sub_skipped' => 0, 56 'tests' => 1, 57 'todo' => 0 58 } 59 }, 60 join( 61 ',', @test_list 62 ) => { 63 'failed' => { 64 "$TEST_DIR/die" => { 65 'canon' => '??', 66 'estat' => 1, 67 'failed' => '??', 68 'max' => '??', 69 'name' => "$TEST_DIR/die", 70 'wstat' => '256' 71 }, 72 "$TEST_DIR/die_head_end" => { 73 'canon' => '??', 74 'estat' => 1, 75 'failed' => '??', 76 'max' => '??', 77 'name' => "$TEST_DIR/die_head_end", 78 'wstat' => '256' 79 }, 80 "$TEST_DIR/die_last_minute" => { 81 'canon' => '??', 82 'estat' => 1, 83 'failed' => 0, 84 'max' => 4, 85 'name' => "$TEST_DIR/die_last_minute", 86 'wstat' => '256' 87 }, 88 "$TEST_DIR/duplicates" => { 89 'canon' => '??', 90 'estat' => '', 91 'failed' => '??', 92 'max' => 10, 93 'name' => "$TEST_DIR/duplicates", 94 'wstat' => '' 95 }, 96 "$TEST_DIR/head_fail" => { 97 'canon' => 2, 98 'estat' => '', 99 'failed' => 1, 100 'max' => 4, 101 'name' => "$TEST_DIR/head_fail", 102 'wstat' => '' 103 }, 104 $NoTaintSupport ? () : ( 105 "$TEST_DIR/inc_taint" => { 106 'canon' => 1, 107 'estat' => 1, 108 'failed' => 1, 109 'max' => 1, 110 'name' => "$TEST_DIR/inc_taint", 111 'wstat' => '256' 112 }), 113 "$TEST_DIR/no_nums" => { 114 'canon' => 3, 115 'estat' => '', 116 'failed' => 1, 117 'max' => 5, 118 'name' => "$TEST_DIR/no_nums", 119 'wstat' => '' 120 }, 121 "$TEST_DIR/no_output" => { 122 'canon' => '??', 123 'estat' => '', 124 'failed' => '??', 125 'max' => '??', 126 'name' => "$TEST_DIR/no_output", 127 'wstat' => '' 128 }, 129 "$TEST_DIR/simple_fail" => { 130 'canon' => '2 5', 131 'estat' => '', 132 'failed' => 2, 133 'max' => 5, 134 'name' => "$TEST_DIR/simple_fail", 135 'wstat' => '' 136 }, 137 "$TEST_DIR/todo_misparse" => { 138 'canon' => 1, 139 'estat' => '', 140 'failed' => 1, 141 'max' => 1, 142 'name' => "$TEST_DIR/todo_misparse", 143 'wstat' => '' 144 }, 145 "$TEST_DIR/too_many" => { 146 'canon' => '4-7', 147 'estat' => 4, 148 'failed' => 4, 149 'max' => 3, 150 'name' => "$TEST_DIR/too_many", 151 'wstat' => '1024' 152 }, 153 "$TEST_DIR/vms_nit" => { 154 'canon' => 1, 155 'estat' => '', 156 'failed' => 1, 157 'max' => 2, 158 'name' => "$TEST_DIR/vms_nit", 159 'wstat' => '' 160 } 161 }, 162 'todo' => { 163 "$TEST_DIR/todo_inline" => { 164 'canon' => 2, 165 'estat' => '', 166 'failed' => 1, 167 'max' => 2, 168 'name' => "$TEST_DIR/todo_inline", 169 'wstat' => '' 170 } 171 }, 172 'totals' => { 173 'bad' => ($NoTaintSupport ? 11 : 12), 174 'bonus' => 1, 175 'files' => ($NoTaintSupport ? 24 : 27), 176 'good' => ($NoTaintSupport ? 13 : 15), 177 'max' => ($NoTaintSupport ? 72 : 76), 178 'ok' => ($NoTaintSupport ? 75 : 78), 179 'skipped' => 2, 180 'sub_skipped' => 2, 181 'tests' => ($NoTaintSupport ? 24 : 27), 182 'todo' => 2 183 } 184 }, 185 'die' => { 186 'failed' => { 187 "$TEST_DIR/die" => { 188 'canon' => '??', 189 'estat' => 1, 190 'failed' => '??', 191 'max' => '??', 192 'name' => "$TEST_DIR/die", 193 'wstat' => '256' 194 } 195 }, 196 'todo' => {}, 197 'totals' => { 198 'bad' => 1, 199 'bonus' => 0, 200 'files' => 1, 201 'good' => 0, 202 'max' => 0, 203 'ok' => 0, 204 'skipped' => 0, 205 'sub_skipped' => 0, 206 'tests' => 1, 207 'todo' => 0 208 } 209 }, 210 'die_head_end' => { 211 'failed' => { 212 "$TEST_DIR/die_head_end" => { 213 'canon' => '??', 214 'estat' => 1, 215 'failed' => '??', 216 'max' => '??', 217 'name' => "$TEST_DIR/die_head_end", 218 'wstat' => '256' 219 } 220 }, 221 'todo' => {}, 222 'totals' => { 223 'bad' => 1, 224 'bonus' => 0, 225 'files' => 1, 226 'good' => 0, 227 'max' => 0, 228 'ok' => 4, 229 'skipped' => 0, 230 'sub_skipped' => 0, 231 'tests' => 1, 232 'todo' => 0 233 } 234 }, 235 'die_last_minute' => { 236 'failed' => { 237 "$TEST_DIR/die_last_minute" => { 238 'canon' => '??', 239 'estat' => 1, 240 'failed' => 0, 241 'max' => 4, 242 'name' => "$TEST_DIR/die_last_minute", 243 'wstat' => '256' 244 } 245 }, 246 'todo' => {}, 247 'totals' => { 248 'bad' => 1, 249 'bonus' => 0, 250 'files' => 1, 251 'good' => 0, 252 'max' => 4, 253 'ok' => 4, 254 'skipped' => 0, 255 'sub_skipped' => 0, 256 'tests' => 1, 257 'todo' => 0 258 } 259 }, 260 'duplicates' => { 261 'failed' => { 262 "$TEST_DIR/duplicates" => { 263 'canon' => '??', 264 'estat' => '', 265 'failed' => '??', 266 'max' => 10, 267 'name' => "$TEST_DIR/duplicates", 268 'wstat' => '' 269 } 270 }, 271 'todo' => {}, 272 'totals' => { 273 'bad' => 1, 274 'bonus' => 0, 275 'files' => 1, 276 'good' => 0, 277 'max' => 10, 278 'ok' => 11, 279 'skipped' => 0, 280 'sub_skipped' => 0, 281 'tests' => 1, 282 'todo' => 0 283 } 284 }, 285 'head_end' => { 286 'failed' => {}, 287 'todo' => {}, 288 'totals' => { 289 'bad' => 0, 290 'bonus' => 0, 291 'files' => 1, 292 'good' => 1, 293 'max' => 4, 294 'ok' => 4, 295 'skipped' => 0, 296 'sub_skipped' => 0, 297 'tests' => 1, 298 'todo' => 0 299 } 300 }, 301 'head_fail' => { 302 'failed' => { 303 "$TEST_DIR/head_fail" => { 304 'canon' => 2, 305 'estat' => '', 306 'failed' => 1, 307 'max' => 4, 308 'name' => "$TEST_DIR/head_fail", 309 'wstat' => '' 310 } 311 }, 312 'todo' => {}, 313 'totals' => { 314 'bad' => 1, 315 'bonus' => 0, 316 'files' => 1, 317 'good' => 0, 318 'max' => 4, 319 'ok' => 3, 320 'skipped' => 0, 321 'sub_skipped' => 0, 322 'tests' => 1, 323 'todo' => 0 324 } 325 }, 326 'inc_taint' => { 327 'skip_if' => sub { $NoTaintSupport }, 328 'failed' => { 329 "$TEST_DIR/inc_taint" => { 330 'canon' => 1, 331 'estat' => 1, 332 'failed' => 1, 333 'max' => 1, 334 'name' => "$TEST_DIR/inc_taint", 335 'wstat' => '256' 336 } 337 }, 338 'todo' => {}, 339 'totals' => { 340 'bad' => 1, 341 'bonus' => 0, 342 'files' => 1, 343 'good' => 0, 344 'max' => 1, 345 'ok' => 0, 346 'skipped' => 0, 347 'sub_skipped' => 0, 348 'tests' => 1, 349 'todo' => 0 350 } 351 }, 352 'junk_before_plan' => { 353 'failed' => {}, 354 'todo' => {}, 355 'totals' => { 356 'bad' => 0, 357 'bonus' => 0, 358 'files' => 1, 359 'good' => 1, 360 'max' => 1, 361 'ok' => 1, 362 'skipped' => 0, 363 'sub_skipped' => 0, 364 'tests' => 1, 365 'todo' => 0 366 } 367 }, 368 'lone_not_bug' => { 369 'failed' => {}, 370 'todo' => {}, 371 'totals' => { 372 'bad' => 0, 373 'bonus' => 0, 374 'files' => 1, 375 'good' => 1, 376 'max' => 4, 377 'ok' => 4, 378 'skipped' => 0, 379 'sub_skipped' => 0, 380 'tests' => 1, 381 'todo' => 0 382 } 383 }, 384 'no_nums' => { 385 'failed' => { 386 "$TEST_DIR/no_nums" => { 387 'canon' => 3, 388 'estat' => '', 389 'failed' => 1, 390 'max' => 5, 391 'name' => "$TEST_DIR/no_nums", 392 'wstat' => '' 393 } 394 }, 395 'todo' => {}, 396 'totals' => { 397 'bad' => 1, 398 'bonus' => 0, 399 'files' => 1, 400 'good' => 0, 401 'max' => 5, 402 'ok' => 4, 403 'skipped' => 0, 404 'sub_skipped' => 0, 405 'tests' => 1, 406 'todo' => 0 407 } 408 }, 409 'no_output' => { 410 'failed' => { 411 "$TEST_DIR/no_output" => { 412 'canon' => '??', 413 'estat' => '', 414 'failed' => '??', 415 'max' => '??', 416 'name' => "$TEST_DIR/no_output", 417 'wstat' => '' 418 } 419 }, 420 'todo' => {}, 421 'totals' => { 422 'bad' => 1, 423 'bonus' => 0, 424 'files' => 1, 425 'good' => 0, 426 'max' => 0, 427 'ok' => 0, 428 'skipped' => 0, 429 'sub_skipped' => 0, 430 'tests' => 1, 431 'todo' => 0 432 } 433 }, 434 'schwern' => { 435 'failed' => {}, 436 'todo' => {}, 437 'totals' => { 438 'bad' => 0, 439 'bonus' => 0, 440 'files' => 1, 441 'good' => 1, 442 'max' => 1, 443 'ok' => 1, 444 'skipped' => 0, 445 'sub_skipped' => 0, 446 'tests' => 1, 447 'todo' => 0 448 } 449 }, 450 'sequence_misparse' => { 451 'failed' => {}, 452 'todo' => {}, 453 'totals' => { 454 'bad' => 0, 455 'bonus' => 0, 456 'files' => 1, 457 'good' => 1, 458 'max' => 5, 459 'ok' => 5, 460 'skipped' => 0, 461 'sub_skipped' => 0, 462 'tests' => 1, 463 'todo' => 0 464 } 465 }, 466 'shbang_misparse' => { 467 'skip_if' => sub { $NoTaintSupport }, 468 'failed' => {}, 469 'todo' => {}, 470 'totals' => { 471 'bad' => 0, 472 'bonus' => 0, 473 'files' => 1, 474 'good' => 1, 475 'max' => 2, 476 'ok' => 2, 477 'skipped' => 0, 478 'sub_skipped' => 0, 479 'tests' => 1, 480 'todo' => 0 481 } 482 }, 483 'simple' => { 484 'failed' => {}, 485 'todo' => {}, 486 'totals' => { 487 'bad' => 0, 488 'bonus' => 0, 489 'files' => 1, 490 'good' => 1, 491 'max' => 5, 492 'ok' => 5, 493 'skipped' => 0, 494 'sub_skipped' => 0, 495 'tests' => 1, 496 'todo' => 0 497 } 498 }, 499 'simple_fail' => { 500 'failed' => { 501 "$TEST_DIR/simple_fail" => { 502 'canon' => '2 5', 503 'estat' => '', 504 'failed' => 2, 505 'max' => 5, 506 'name' => "$TEST_DIR/simple_fail", 507 'wstat' => '' 508 } 509 }, 510 'todo' => {}, 511 'totals' => { 512 'bad' => 1, 513 'bonus' => 0, 514 'files' => 1, 515 'good' => 0, 516 'max' => 5, 517 'ok' => 3, 518 'skipped' => 0, 519 'sub_skipped' => 0, 520 'tests' => 1, 521 'todo' => 0 522 } 523 }, 524 'skip' => { 525 'failed' => {}, 526 'todo' => {}, 527 'totals' => { 528 'bad' => 0, 529 'bonus' => 0, 530 'files' => 1, 531 'good' => 1, 532 'max' => 5, 533 'ok' => 5, 534 'skipped' => 0, 535 'sub_skipped' => 1, 536 'tests' => 1, 537 'todo' => 0 538 } 539 }, 540 'skip_nomsg' => { 541 'failed' => {}, 542 'todo' => {}, 543 'totals' => { 544 'bad' => 0, 545 'bonus' => 0, 546 'files' => 1, 547 'good' => 1, 548 'max' => 1, 549 'ok' => 1, 550 'skipped' => 0, 551 'sub_skipped' => 1, 552 'tests' => 1, 553 'todo' => 0 554 } 555 }, 556 'skipall' => { 557 'failed' => {}, 558 'todo' => {}, 559 'totals' => { 560 'bad' => 0, 561 'bonus' => 0, 562 'files' => 1, 563 'good' => 1, 564 'max' => 0, 565 'ok' => 0, 566 'skipped' => 1, 567 'sub_skipped' => 0, 568 'tests' => 1, 569 'todo' => 0 570 } 571 }, 572 'skipall_nomsg' => { 573 'failed' => {}, 574 'todo' => {}, 575 'totals' => { 576 'bad' => 0, 577 'bonus' => 0, 578 'files' => 1, 579 'good' => 1, 580 'max' => 0, 581 'ok' => 0, 582 'skipped' => 1, 583 'sub_skipped' => 0, 584 'tests' => 1, 585 'todo' => 0 586 } 587 }, 588 'stdout_stderr' => { 589 'failed' => {}, 590 'todo' => {}, 591 'totals' => { 592 'bad' => 0, 593 'bonus' => 0, 594 'files' => 1, 595 'good' => 1, 596 'max' => 4, 597 'ok' => 4, 598 'skipped' => 0, 599 'sub_skipped' => 0, 600 'tests' => 1, 601 'todo' => 0 602 } 603 }, 604 'switches' => { 605 'skip_if' => sub { 606 ( $ENV{PERL5OPT} || '' ) =~ m{(?:^|\s)-[dM]}; 607 }, 608 'failed' => { 609 "$TEST_DIR/switches" => { 610 'canon' => 1, 611 'estat' => '', 612 'failed' => 1, 613 'max' => 1, 614 'name' => "$TEST_DIR/switches", 615 'wstat' => '' 616 } 617 }, 618 'todo' => {}, 619 'totals' => { 620 'bad' => 1, 621 'bonus' => 0, 622 'files' => 1, 623 'good' => 0, 624 'max' => 1, 625 'ok' => 0, 626 'skipped' => 0, 627 'sub_skipped' => 0, 628 'tests' => 1, 629 'todo' => 0 630 } 631 }, 632 'taint' => { 633 'skip_if' => sub { $NoTaintSupport }, 634 'failed' => {}, 635 'todo' => {}, 636 'totals' => { 637 'bad' => 0, 638 'bonus' => 0, 639 'files' => 1, 640 'good' => 1, 641 'max' => 1, 642 'ok' => 1, 643 'skipped' => 0, 644 'sub_skipped' => 0, 645 'tests' => 1, 646 'todo' => 0 647 } 648 }, 649 'taint_warn' => { 650 'skip_if' => sub { $NoTaintSupport }, 651 'failed' => {}, 652 'todo' => {}, 653 'totals' => { 654 'bad' => 0, 655 'bonus' => 0, 656 'files' => 1, 657 'good' => 1, 658 'max' => 1, 659 'ok' => 1, 660 'skipped' => 0, 661 'sub_skipped' => 0, 662 'tests' => 1, 663 'todo' => 0 664 }, 665 'require' => 5.008001, 666 }, 667 'todo_inline' => { 668 'failed' => {}, 669 'todo' => { 670 "$TEST_DIR/todo_inline" => { 671 'canon' => 2, 672 'estat' => '', 673 'failed' => 1, 674 'max' => 2, 675 'name' => "$TEST_DIR/todo_inline", 676 'wstat' => '' 677 } 678 }, 679 'totals' => { 680 'bad' => 0, 681 'bonus' => 1, 682 'files' => 1, 683 'good' => 1, 684 'max' => 3, 685 'ok' => 3, 686 'skipped' => 0, 687 'sub_skipped' => 0, 688 'tests' => 1, 689 'todo' => 2 690 } 691 }, 692 'todo_misparse' => { 693 'failed' => { 694 "$TEST_DIR/todo_misparse" => { 695 'canon' => 1, 696 'estat' => '', 697 'failed' => 1, 698 'max' => 1, 699 'name' => "$TEST_DIR/todo_misparse", 700 'wstat' => '' 701 } 702 }, 703 'todo' => {}, 704 'totals' => { 705 'bad' => 1, 706 'bonus' => 0, 707 'files' => 1, 708 'good' => 0, 709 'max' => 1, 710 'ok' => 0, 711 'skipped' => 0, 712 'sub_skipped' => 0, 713 'tests' => 1, 714 'todo' => 0 715 } 716 }, 717 'too_many' => { 718 'failed' => { 719 "$TEST_DIR/too_many" => { 720 'canon' => '4-7', 721 'estat' => 4, 722 'failed' => 4, 723 'max' => 3, 724 'name' => "$TEST_DIR/too_many", 725 'wstat' => '1024' 726 } 727 }, 728 'todo' => {}, 729 'totals' => { 730 'bad' => 1, 731 'bonus' => 0, 732 'files' => 1, 733 'good' => 0, 734 'max' => 3, 735 'ok' => 7, 736 'skipped' => 0, 737 'sub_skipped' => 0, 738 'tests' => 1, 739 'todo' => 0 740 } 741 }, 742 'vms_nit' => { 743 'failed' => { 744 "$TEST_DIR/vms_nit" => { 745 'canon' => 1, 746 'estat' => '', 747 'failed' => 1, 748 'max' => 2, 749 'name' => "$TEST_DIR/vms_nit", 750 'wstat' => '' 751 } 752 }, 753 'todo' => {}, 754 'totals' => { 755 'bad' => 1, 756 'bonus' => 0, 757 'files' => 1, 758 'good' => 0, 759 'max' => 2, 760 'ok' => 1, 761 'skipped' => 0, 762 'sub_skipped' => 0, 763 'tests' => 1, 764 'todo' => 0 765 } 766 } 767 }; 768 769 my $num_tests = ( keys %$results ) * $PER_LOOP; 770 771 plan tests => $num_tests; 772 773 sub local_name { 774 my $name = shift; 775 return File::Spec->catfile( split /\//, $name ); 776 } 777 778 sub local_result { 779 my $hash = shift; 780 my $new = {}; 781 782 while ( my ( $file, $want ) = each %$hash ) { 783 if ( exists $want->{name} ) { 784 $want->{name} = local_name( $want->{name} ); 785 } 786 $new->{ local_name($file) } = $want; 787 } 788 return $new; 789 } 790 791 sub vague_status { 792 my $hash = shift; 793 return $hash unless $^O eq 'VMS'; 794 795 while ( my ( $file, $want ) = each %$hash ) { 796 for (qw( estat wstat )) { 797 if ( exists $want->{$_} ) { 798 $want->{$_} = $want->{$_} ? 1 : 0; 799 } 800 } 801 } 802 return $hash; 803 } 804 805 { 806 local $^W = 0; 807 808 # Silence harness output 809 *TAP::Formatter::Console::_output = sub { 810 811 # do nothing 812 }; 813 } 814 815 for my $test_key ( sort keys %$results ) { 816 my $result = $results->{$test_key}; 817 SKIP: { 818 if ( $result->{require} && $] < $result->{require} ) { 819 skip "Test requires Perl $result->{require}, we have $]", 4; 820 } 821 822 if ( my $skip_if = $result->{skip_if} ) { 823 skip 824 "Test '$test_key' can't run properly in this environment", 4 825 if $skip_if->(); 826 } 827 828 if (($test_key eq 'inc_taint' || $test_key eq 'shbang_misparse') && $NoTaintSupport) { 829 skip "your perl was built without taint support", 4; 830 } 831 832 my @test_names = split( /,/, $test_key ); 833 my @test_files 834 = map { File::Spec->catfile( $TEST_DIR, $_ ) } @test_names; 835 836 # For now we supress STDERR because it crufts up /our/ test 837 # results. Should probably capture and analyse it. 838 local ( *OLDERR, *OLDOUT ); 839 open OLDERR, '>&STDERR' or die $!; 840 open OLDOUT, '>&STDOUT' or die $!; 841 my $devnull = File::Spec->devnull; 842 open STDERR, ">$devnull" or die $!; 843 open STDOUT, ">$devnull" or die $!; 844 845 my ( $tot, $fail, $todo, $harness, $aggregate ) 846 = execute_tests( tests => \@test_files ); 847 848 open STDERR, '>&OLDERR' or die $!; 849 open STDOUT, '>&OLDOUT' or die $!; 850 851 my $bench = delete $tot->{bench}; 852 isa_ok $bench, 'Benchmark'; 853 854 # Localise filenames in failed, todo 855 my $lfailed = vague_status( local_result( $result->{failed} ) ); 856 my $ltodo = vague_status( local_result( $result->{todo} ) ); 857 858 # use Data::Dumper; 859 # diag Dumper( [ $lfailed, $ltodo ] ); 860 861 is_deeply $tot, $result->{totals}, "totals match for $test_key"; 862 is_deeply vague_status($fail), $lfailed, 863 "failure summary matches for $test_key"; 864 is_deeply vague_status($todo), $ltodo, 865 "todo summary matches for $test_key"; 866 } 867 } 868} 869