lib/Test/Builder.pm

   1 package Test::Builder;
   2
   3 use 5.004;
   4
   5 # $^C was only introduced in 5.005-ish.  We do this to prevent
   6 # use of uninitialized value warnings in older perls.
   7 $^C ||= 0;
   8
   9 use strict;
  10 use vars qw($VERSION $CLASS);
  11 $VERSION = 0.03;
  12 $CLASS = __PACKAGE__;
  13
  14 my $IsVMS = $^O eq 'VMS';
  15
  16 use vars qw($Level);
  17 my @Test_Results = ();
  18 my @Test_Details = ();
  19 my($Test_Died) = 0;
  20 my($Have_Plan) = 0;
  21 my $Curr_Test = 0;
  22
  23
  24 =head1 NAME
  25
  26 Test::Builder - Backend for building test libraries
  27
  28 =head1 SYNOPSIS
  29
  30   package My::Test::Module;
  31   use Test::Builder;
  32   require Exporter;
  33   @ISA = qw(Exporter);
  34   @EXPORT = qw(ok);
  35
  36   my $Test = Test::Builder->new;
  37   $Test->output('my_logfile');
  38
  39   sub import {
  40       my($self) = shift;
  41       my $pack = caller;
  42
  43       $Test->exported_to($pack);
  44       $Test->plan(@_);
  45
  46       $self->export_to_level(1, $self, 'ok');
  47   }
  48
  49   sub ok {
  50       my($test, $name) = @_;
  51
  52       $Test->ok($test, $name);
  53   }
  54
  55
  56 =head1 DESCRIPTION
  57
  58 I<THIS IS ALPHA GRADE SOFTWARE>  The interface will change.
  59
  60 Test::Simple and Test::More have proven to be popular testing modules,
  61 but they're not always flexible enough.  Test::Builder provides the
  62 a building block upon which to write your own test libraries.
  63
  64 =head2 Construction
  65
  66 =over 4
  67
  68 =item B<new>
  69
  70   my $Test = Test::Builder->new;
  71
  72 Returns a Test::Builder object representing the current state of the
  73 test.
  74
  75 Since you only run one test per program, there is B<one and only one>
  76 Test::Builder object.  No matter how many times you call new(), you're
  77 getting the same object.  (This is called a singleton).
  78
  79 =cut
  80
  81 my $Test;
  82 sub new {
  83     my($class) = shift;
  84     $Test ||= bless ['Move along, nothing to see here'], $class;
  85     return $Test;
  86 }
  87
  88 =back
  89
  90 =head2 Setting up tests
  91
  92 These methods are for setting up tests and declaring how many there
  93 are.  You usually only want to call one of these methods.
  94
  95 =over 4
  96
  97 =item B<exported_to>
  98
  99   my $pack = $Test->exported_to;
 100   $Test->exported_to($pack);
 101
 102 Tells Test::Builder what package you exported your functions to.
 103 This is important for getting TODO tests right.
 104
 105 =cut
 106
 107 my $Exported_To;
 108 sub exported_to {
 109     my($self, $pack) = @_;
 110
 111     if( defined $pack ) {
 112         $Exported_To = $pack;
 113     }
 114     return $Exported_To;
 115 }
 116
 117 =item B<plan>
 118
 119   $Test->plan('no_plan');
 120   $Test->plan( skip_all => $reason );
 121   $Test->plan( tests => $num_tests );
 122
 123 A convenient way to set up your tests.  Call this and Test::Builder
 124 will print the appropriate headers and take the appropriate actions.
 125
 126 If you call plan(), don't call any of the other methods below.
 127
 128 =cut
 129
 130 sub plan {
 131     my($self, $cmd, $arg) = @_;
 132
 133     return unless $cmd;
 134
 135     if( $cmd eq 'no_plan' ) {
 136         $self->no_plan;
 137     }
 138     elsif( $cmd eq 'skip_all' ) {
 139         return $self->skip_all($arg);
 140     }
 141     elsif( $cmd eq 'tests' ) {
 142         if( $arg ) {
 143             return $self->expected_tests($arg);
 144         }
 145         elsif( !defined $arg ) {
 146             die "Got an undefined number of tests.  Looks like you tried to ".
 147                 "say how many tests you plan to run but made a mistake.\n";
 148         }
 149         elsif( !$arg ) {
 150             die "You said to run 0 tests!  You've got to run something.\n";
 151         }
 152     }
 153 }
 154
 155 =item B<expected_tests>
 156
 157     my $max = $Test->expected_tests;
 158     $Test->expected_tests($max);
 159
 160 Gets/sets the # of tests we expect this test to run and prints out
 161 the appropriate headers.
 162
 163 =cut
 164
 165 my $Expected_Tests = 0;
 166 sub expected_tests {
 167     my($self, $max) = @_;
 168
 169     if( defined $max ) {
 170         $Expected_Tests = $max;
 171         $Have_Plan      = 1;
 172
 173         $self->_print("1..$max\n") unless $self->no_header;
 174     }
 175     return $Expected_Tests;
 176 }
 177
 178
 179 =item B<no_plan>
 180
 181   $Test->no_plan;
 182
 183 Declares that this test will run an indeterminate # of tests.
 184
 185 =cut
 186
 187 my($No_Plan) = 0;
 188 sub no_plan {
 189     $No_Plan    = 1;
 190     $Have_Plan  = 1;
 191 }
 192
 193 =item B<skip_all>
 194
 195   $Test->skip_all;
 196   $Test->skip_all($reason);
 197
 198 Skips all the tests, using the given $reason.  Exits immediately with 0.
 199
 200 =cut
 201
 202 my $Skip_All = 0;
 203 sub skip_all {
 204     my($self, $reason) = @_;
 205
 206     my $out = "1..0";
 207     $out .= " # Skip $reason" if $reason;
 208     $out .= "\n";
 209
 210     $Skip_All = 1;
 211
 212     $self->_print($out) unless $self->no_header;
 213     exit(0);
 214 }
 215
 216 =back
 217
 218 =head2 Running tests
 219
 220 These actually run the tests, analogous to the functions in
 221 Test::More.
 222
 223 $name is always optional.
 224
 225 =over 4
 226
 227 =item B<ok>
 228
 229   $Test->ok($test, $name);
 230
 231 Your basic test.  Pass if $test is true, fail if $test is false.  Just
 232 like Test::Simple's ok().
 233
 234 =cut
 235
 236 sub ok {
 237     my($self, $test, $name) = @_;
 238
 239     unless( $Have_Plan ) {
 240         die "You tried to run a test without a plan!  Gotta have a plan.\n";
 241     }
 242
 243     $Curr_Test++;
 244
 245     $self->diag(<<ERR) if defined $name and $name =~ /^[\d\s]+$/;
 246 You named your test '$name'.  You shouldn't use numbers for your test names.
 247 Very confusing.
 248 ERR
 249
 250     my($pack, $file, $line) = $self->caller;
 251
 252     my $todo = $self->todo($pack);
 253
 254     my $out;
 255     unless( $test ) {
 256         $out .= "not ";
 257         $Test_Results[$Curr_Test-1] = $todo ? 1 : 0;
 258     }
 259     else {
 260         $Test_Results[$Curr_Test-1] = 1;
 261     }
 262
 263     $out .= "ok";
 264     $out .= " $Curr_Test" if $self->use_numbers;
 265
 266     if( defined $name ) {
 267         $name =~ s|#|\\#|g;     # # in a name can confuse Test::Harness.
 268         $out   .= " - $name";
 269     }
 270
 271     if( $todo ) {
 272         my $what_todo = $todo;
 273         $out   .= " # TODO $what_todo";
 274     }
 275
 276     $out .= "\n";
 277
 278     $self->_print($out);
 279
 280     unless( $test ) {
 281         my $msg = $todo ? "Failed (TODO)" : "Failed";
 282         $self->diag("$msg test ($file at line $line)\n");
 283     }
 284
 285     return $test ? 1 : 0;
 286 }
 287
 288 =item B<is_eq>
 289
 290   $Test->is_eq($got, $expected, $name);
 291
 292 Like Test::More's is().  Checks if $got eq $expected.  This is the
 293 string version.
 294
 295 =item B<is_num>
 296
 297   $Test->is_num($get, $expected, $name);
 298
 299 Like Test::More's is().  Checks if $got == $expected.  This is the
 300 numeric version.
 301
 302 =cut
 303
 304 sub is_eq {
 305     my $self = shift;
 306     local $Level = $Level + 1;
 307     return $self->_is('eq', @_);
 308 }
 309
 310 sub is_num {
 311     my $self = shift;
 312     local $Level = $Level + 1;
 313     return $self->_is('==', @_);
 314 }
 315
 316 sub _is {
 317     my($self, $type, $got, $expect, $name) = @_;
 318
 319     my $test;
 320     {
 321         local $^W = 0;      # so we can compare undef quietly
 322         $test = $type eq 'eq' ? $got eq $expect
 323                               : $got == $expect;
 324     }
 325     local $Level = $Level + 1;
 326     my $ok = $self->ok($test, $name);
 327
 328     unless( $ok ) {
 329         $got    = defined $got    ? "'$got'"    : 'undef';
 330         $expect = defined $expect ? "'$expect'" : 'undef';
 331         $self->diag(sprintf <<DIAGNOSTIC, $got, $expect);
 332      got: %s
 333 expected: %s
 334 DIAGNOSTIC
 335     }
 336
 337     return $ok;
 338 }
 339
 340 =item B<like>
 341
 342   $Test->like($this, qr/$regex/, $name);
 343   $Test->like($this, '/$regex/', $name);
 344
 345 Like Test::More's like().  Checks if $this matches the given $regex.
 346
 347 You'll want to avoid qr// if you want your tests to work before 5.005.
 348
 349 =cut
 350
 351 sub like {
 352     my($self, $this, $regex, $name) = @_;
 353
 354     local $Level = $Level + 1;
 355
 356     my $ok = 0;
 357     if( ref $regex eq 'Regexp' ) {
 358         local $^W = 0;
 359         $ok = $self->ok( $this =~ $regex ? 1 : 0, $name );
 360     }
 361     # Check if it looks like '/foo/'
 362     elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) {
 363         local $^W = 0;
 364         $ok = $self->ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name );
 365     }
 366     else {
 367         $ok = $self->ok( 0, $name );
 368
 369         $self->diag("'$regex' doesn't look much like a regex to me.");
 370
 371         return $ok;
 372     }
 373
 374     unless( $ok ) {
 375         $this = defined $this ? "'$this'" : 'undef';
 376         $self->diag(sprintf <<DIAGNOSTIC, $this);
 377               %s
 378 doesn't match '$regex'
 379 DIAGNOSTIC
 380
 381     }
 382
 383     return $ok;
 384 }
 385
 386 =item B<skip>
 387
 388     $Test->skip;
 389     $Test->skip($why);
 390
 391 Skips the current test, reporting $why.
 392
 393 =cut
 394
 395 sub skip {
 396     my($self, $why) = @_;
 397     $why ||= '';
 398
 399     unless( $Have_Plan ) {
 400         die "You tried to run tests without a plan!  Gotta have a plan.\n";
 401     }
 402
 403     $Curr_Test++;
 404
 405     $Test_Results[$Curr_Test-1] = 1;
 406
 407     my $out = "ok";
 408     $out   .= " $Curr_Test" if $self->use_numbers;
 409     $out   .= " # skip $why\n";
 410
 411     $Test->_print($out);
 412
 413     return 1;
 414 }
 415
 416 =begin _unimplemented
 417
 418 =item B<skip_rest>
 419
 420   $Test->skip_rest;
 421   $Test->skip_rest($reason);
 422
 423 Like skip(), only it skips all the rest of the tests you plan to run
 424 and terminates the test.
 425
 426 If you're running under no_plan, it skips once and terminates the
 427 test.
 428
 429 =end _unimplemented
 430
 431 =back
 432
 433
 434 =head2 Test style
 435
 436 =over 4
 437
 438 =item B<level>
 439
 440     $Test->level($how_high);
 441
 442 How far up the call stack should $Test look when reporting where the
 443 test failed.
 444
 445 Defaults to 1.
 446
 447 Setting $Test::Builder::Level overrides.  This is typically useful
 448 localized:
 449
 450     {
 451         local $Test::Builder::Level = 2;
 452         $Test->ok($test);
 453     }
 454
 455 =cut
 456
 457 sub level {
 458     my($self, $level) = @_;
 459
 460     if( defined $level ) {
 461         $Level = $level;
 462     }
 463     return $Level;
 464 }
 465
 466 $CLASS->level(1);
 467
 468
 469 =item B<use_numbers>
 470
 471     $Test->use_numbers($on_or_off);
 472
 473 Whether or not the test should output numbers.  That is, this if true:
 474
 475   ok 1
 476   ok 2
 477   ok 3
 478
 479 or this if false
 480
 481   ok
 482   ok
 483   ok
 484
 485 Most useful when you can't depend on the test output order, such as
 486 when threads or forking is involved.
 487
 488 Test::Harness will accept either, but avoid mixing the two styles.
 489
 490 Defaults to on.
 491
 492 =cut
 493
 494 my $Use_Nums = 1;
 495 sub use_numbers {
 496     my($self, $use_nums) = @_;
 497
 498     if( defined $use_nums ) {
 499         $Use_Nums = $use_nums;
 500     }
 501     return $Use_Nums;
 502 }
 503
 504 =item B<no_header>
 505
 506     $Test->no_header($no_header);
 507
 508 If set to true, no "1..N" header will be printed.
 509
 510 =item B<no_ending>
 511
 512     $Test->no_ending($no_ending);
 513
 514 Normally, Test::Builder does some extra diagnostics when the test
 515 ends.  It also changes the exit code as described in Test::Simple.
 516
 517 If this is true, none of that will be done.
 518
 519 =cut
 520
 521 my($No_Header, $No_Ending) = (0,0);
 522 sub no_header {
 523     my($self, $no_header) = @_;
 524
 525     if( defined $no_header ) {
 526         $No_Header = $no_header;
 527     }
 528     return $No_Header;
 529 }
 530
 531 sub no_ending {
 532     my($self, $no_ending) = @_;
 533
 534     if( defined $no_ending ) {
 535         $No_Ending = $no_ending;
 536     }
 537     return $No_Ending;
 538 }
 539
 540
 541 =back
 542
 543 =head2 Output
 544
 545 Controlling where the test output goes.
 546
 547 =over 4
 548
 549 =item B<diag>
 550
 551     $Test->diag(@msgs);
 552
 553 Prints out the given $message.  Normally, it uses the failure_output()
 554 handle, but if this is for a TODO test, the todo_output() handle is
 555 used.
 556
 557 Output will be indented and prepended with a # as not to interfere
 558 with test output.
 559
 560 We encourage using this rather than calling print directly.
 561
 562 =cut
 563
 564 sub diag {
 565     my($self, @msgs) = @_;
 566
 567     # Prevent printing headers when compiling (ie. -c)
 568     return if $^C;
 569
 570     # Escape each line with a #.
 571     foreach (@msgs) {
 572         s/^([^#])/#     $1/;
 573         s/\n([^#])/\n#     $1/g;
 574     }
 575
 576     local $Level = $Level + 1;
 577     my $fh = $self->todo ? $self->todo_output : $self->failure_output;
 578     local($\, $", $,) = (undef, ' ', '');
 579     print $fh @msgs;
 580 }
 581
 582 =begin _private
 583
 584 =item B<_print>
 585
 586     $Test->_print(@msgs);
 587
 588 Prints to the output() filehandle.
 589
 590 =end _private
 591
 592 =cut
 593
 594 sub _print {
 595     my($self, @msgs) = @_;
 596
 597     # Prevent printing headers when only compiling.  Mostly for when
 598     # tests are deparsed with B::Deparse
 599     return if $^C;
 600
 601     local($\, $", $,) = (undef, ' ', '');
 602     my $fh = $self->output;
 603     print $fh @msgs;
 604 }
 605
 606
 607 =item B<output>
 608
 609     $Test->output($fh);
 610     $Test->output($file);
 611
 612 Where normal "ok/not ok" test output should go.
 613
 614 Defaults to STDOUT.
 615
 616 =item B<failure_output>
 617
 618     $Test->failure_output($fh);
 619     $Test->failure_output($file);
 620
 621 Where diagnostic output on test failures and diag() should go.
 622
 623 Defaults to STDERR.
 624
 625 =item B<todo_output>
 626
 627     $Test->todo_output($fh);
 628     $Test->todo_output($file);
 629
 630 Where diagnostics about todo test failures and diag() should go.
 631
 632 Defaults to STDOUT.
 633
 634 =cut
 635
 636 my($Out_FH, $Fail_FH, $Todo_FH);
 637 sub output {
 638     my($self, $fh) = @_;
 639
 640     if( defined $fh ) {
 641         $Out_FH = _new_fh($fh);
 642     }
 643     return $Out_FH;
 644 }
 645
 646 sub failure_output {
 647     my($self, $fh) = @_;
 648
 649     if( defined $fh ) {
 650         $Fail_FH = _new_fh($fh);
 651     }
 652     return $Fail_FH;
 653 }
 654
 655 sub todo_output {
 656     my($self, $fh) = @_;
 657
 658     if( defined $fh ) {
 659         $Todo_FH = _new_fh($fh);
 660     }
 661     return $Todo_FH;
 662 }
 663
 664 sub _new_fh {
 665     my($file_or_fh) = shift;
 666
 667     my $fh;
 668     unless( UNIVERSAL::isa($file_or_fh, 'GLOB') ) {
 669         $fh = do { local *FH };
 670         open $fh, ">$file_or_fh" or
 671             die "Can't open test output log $file_or_fh: $!";
 672     }
 673     else {
 674         $fh = $file_or_fh;
 675     }
 676
 677     return $fh;
 678 }
 679
 680 unless( $^C ) {
 681     # We dup STDOUT and STDERR so people can change them in their
 682     # test suites while still getting normal test output.
 683     open(TESTOUT, ">&STDOUT") or die "Can't dup STDOUT:  $!";
 684     open(TESTERR, ">&STDERR") or die "Can't dup STDERR:  $!";
 685     _autoflush(\*TESTOUT);
 686     _autoflush(\*TESTERR);
 687     $CLASS->output(\*TESTOUT);
 688     $CLASS->failure_output(\*TESTERR);
 689     $CLASS->todo_output(\*TESTOUT);
 690 }
 691
 692 sub _autoflush {
 693     my($fh) = shift;
 694     my $old_fh = select $fh;
 695     $| = 1;
 696     select $old_fh;
 697 }
 698
 699
 700 =back
 701
 702
 703 =head2 Test Status and Info
 704
 705 =over 4
 706
 707 =item B<current_test>
 708
 709     my $curr_test = $Test->current_test;
 710     $Test->current_test($num);
 711
 712 Gets/sets the current test # we're on.
 713
 714 You usually shouldn't have to set this.
 715
 716 =cut
 717
 718 sub current_test {
 719     my($self, $num) = @_;
 720
 721     if( defined $num ) {
 722         $Curr_Test = $num;
 723     }
 724     return $Curr_Test;
 725 }
 726
 727
 728 =item B<summary>
 729
 730     my @tests = $Test->summary;
 731
 732 A simple summary of the tests so far.  True for pass, false for fail.
 733 This is a logical pass/fail, so todos are passes.
 734
 735 Of course, test #1 is $tests[0], etc...
 736
 737 =cut
 738
 739 sub summary {
 740     my($self) = shift;
 741
 742     return @Test_Results;
 743 }
 744
 745 =item B<details>  I<UNIMPLEMENTED>
 746
 747     my @tests = $Test->details;
 748
 749 Like summary(), but with a lot more detail.
 750
 751     $tests[$test_num - 1] =
 752             { ok         => is the test considered ok?
 753               actual_ok  => did it literally say 'ok'?
 754               name       => name of the test (if any)
 755               type       => 'skip' or 'todo' (if any)
 756               reason     => reason for the above (if any)
 757             };
 758
 759 =item B<todo>
 760
 761     my $todo_reason = $Test->todo;
 762     my $todo_reason = $Test->todo($pack);
 763
 764 todo() looks for a $TODO variable in your tests.  If set, all tests
 765 will be considered 'todo' (see Test::More and Test::Harness for
 766 details).  Returns the reason (ie. the value of $TODO) if running as
 767 todo tests, false otherwise.
 768
 769 todo() is pretty part about finding the right package to look for
 770 $TODO in.  It uses the exported_to() package to find it.  If that's
 771 not set, it's pretty good at guessing the right package to look at.
 772
 773 Sometimes there is some confusion about where todo() should be looking
 774 for the $TODO variable.  If you want to be sure, tell it explicitly
 775 what $pack to use.
 776
 777 =cut
 778
 779 sub todo {
 780     my($self, $pack) = @_;
 781
 782     $pack = $pack || $self->exported_to || $self->caller(1);
 783
 784     no strict 'refs';
 785     return defined ${$pack.'::TODO'} ? ${$pack.'::TODO'}
 786                                      : 0;
 787 }
 788
 789 =item B<caller>
 790
 791     my $package = $Test->caller;
 792     my($pack, $file, $line) = $Test->caller;
 793     my($pack, $file, $line) = $Test->caller($height);
 794
 795 Like the normal caller(), except it reports according to your level().
 796
 797 =cut
 798
 799 sub caller {
 800     my($self, $height) = @_;
 801     $height ||= 0;
 802
 803     my @caller = CORE::caller($self->level + $height + 1);
 804     return wantarray ? @caller : $caller[0];
 805 }
 806
 807 =back
 808
 809 =cut
 810
 811 =begin _private
 812
 813 =over 4
 814
 815 =item B<_sanity_check>
 816
 817   _sanity_check();
 818
 819 Runs a bunch of end of test sanity checks to make sure reality came
 820 through ok.  If anything is wrong it will die with a fairly friendly
 821 error message.
 822
 823 =cut
 824
 825 #'#
 826 sub _sanity_check {
 827     _whoa($Curr_Test < 0,  'Says here you ran a negative number of tests!');
 828     _whoa(!$Have_Plan and $Curr_Test,
 829           'Somehow your tests ran without a plan!');
 830     _whoa($Curr_Test != @Test_Results,
 831           'Somehow you got a different number of results than tests ran!');
 832 }
 833
 834 =item B<_whoa>
 835
 836   _whoa($check, $description);
 837
 838 A sanity check, similar to assert().  If the $check is true, something
 839 has gone horribly wrong.  It will die with the given $description and
 840 a note to contact the author.
 841
 842 =cut
 843
 844 sub _whoa {
 845     my($check, $desc) = @_;
 846     if( $check ) {
 847         die <<WHOA;
 848 WHOA!  $desc
 849 This should never happen!  Please contact the author immediately!
 850 WHOA
 851     }
 852 }
 853
 854 =item B<_my_exit>
 855
 856   _my_exit($exit_num);
 857
 858 Perl seems to have some trouble with exiting inside an END block.  5.005_03
 859 and 5.6.1 both seem to do odd things.  Instead, this function edits $?
 860 directly.  It should ONLY be called from inside an END block.  It
 861 doesn't actually exit, that's your job.
 862
 863 =cut
 864
 865 sub _my_exit {
 866     $? = $_[0];
 867
 868     return 1;
 869 }
 870
 871
 872 =back
 873
 874 =end _private
 875
 876 =cut
 877
 878 $SIG{__DIE__} = sub {
 879     # We don't want to muck with death in an eval, but $^S isn't
 880     # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
 881     # with it.  Instead, we use caller.  This also means it runs under
 882     # 5.004!
 883     my $in_eval = 0;
 884     for( my $stack = 1;  my $sub = (CORE::caller($stack))[3];  $stack++ ) {
 885         $in_eval = 1 if $sub =~ /^\(eval\)/;
 886     }
 887     $Test_Died = 1 unless $in_eval;
 888 };
 889
 890 sub _ending {
 891     my $self = shift;
 892
 893     _sanity_check();
 894
 895     # Bailout if plan() was never called.  This is so
 896     # "require Test::Simple" doesn't puke.
 897     do{ _my_exit(0) && return } if !$Have_Plan;
 898
 899     # Figure out if we passed or failed and print helpful messages.
 900     if( @Test_Results ) {
 901         # The plan?  We have no plan.
 902         if( $No_Plan ) {
 903             $self->_print("1..$Curr_Test\n") unless $self->no_header;
 904             $Expected_Tests = $Curr_Test;
 905         }
 906
 907         my $num_failed = grep !$_, @Test_Results[0..$Expected_Tests-1];
 908         $num_failed += abs($Expected_Tests - @Test_Results);
 909
 910         if( $Curr_Test < $Expected_Tests ) {
 911             $self->diag(<<"FAIL");
 912 # Looks like you planned $Expected_Tests tests but only ran $Curr_Test.
 913 FAIL
 914         }
 915         elsif( $Curr_Test > $Expected_Tests ) {
 916             my $num_extra = $Curr_Test - $Expected_Tests;
 917             $self->diag(<<"FAIL");
 918 # Looks like you planned $Expected_Tests tests but ran $num_extra extra.
 919 FAIL
 920         }
 921         elsif ( $num_failed ) {
 922             $self->diag(<<"FAIL");
 923 # Looks like you failed $num_failed tests of $Expected_Tests.
 924 FAIL
 925         }
 926
 927         if( $Test_Died ) {
 928             $self->diag(<<"FAIL");
 929 # Looks like your test died just after $Curr_Test.
 930 FAIL
 931
 932             _my_exit( 255 ) && return;
 933         }
 934
 935         _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
 936     }
 937     elsif ( $Skip_All ) {
 938         _my_exit( 0 ) && return;
 939     }
 940     else {
 941         $self->diag("# No tests run!\n");
 942         _my_exit( 255 ) && return;
 943     }
 944 }
 945
 946 END {
 947     $Test->_ending if defined $Test and !$Test->no_ending;
 948 }
 949
 950 =head1 EXAMPLES
 951
 952 At this point, Test::Simple and Test::More are your best examples.
 953
 954 =head1 AUTHOR
 955
 956 Original code by chromatic, maintained by Michael G Schwern
 957 E<lt>schwern@pobox.comE<gt>
 958
 959 =head1 SEE ALSO
 960
 961 Test::Simple, Test::More, Test::Harness
 962
 963 =cut
 964
 965 1;