[p5sagit/p5-mst-13.2.git] / lib / Test / Simple.pm

package Test::Simple;

use 5.004;

use strict 'vars';
use Test::Utils;

use vars qw($VERSION);

$VERSION = '0.19';

my(@Test_Results) = ();
my($Num_Tests, $Planned_Tests, $Test_Died) = (0,0,0);
my($Have_Plan) = 0;

my $IsVMS = $^O eq 'VMS';


# I'd like to have Test::Simple interfere with the program being
# tested as little as possible.  This includes using Exporter or
# anything else (including strict).
sub import {
    # preserve caller()
    if( @_ > 1 ) {
        if( $_[1] eq 'no_plan' ) {
            goto &no_plan;
        }
        else {
            goto &plan
        }
    }
}

sub plan {
    my($class, %config) = @_;

    if( !exists $config{tests} ) {
        die "You have to tell $class how many tests you plan to run.\n".
            "  use $class tests => 42;  for example.\n";
    }
    elsif( !defined $config{tests} ) {
        die "Got an undefined number of tests.  Looks like you tried to tell ".
            "$class how many tests you plan to run but made a mistake.\n";
    }
    elsif( !$config{tests} ) {
        die "You told $class you plan to run 0 tests!  You've got to run ".
            "something.\n";
    }
    else {
        $Planned_Tests = $config{tests};
    }

    $Have_Plan = 1;

    my_print *TESTOUT, "1..$Planned_Tests\n";

    no strict 'refs';
    my($caller) = caller;
    *{$caller.'::ok'} = \&ok;
    
}


sub no_plan {
    $Have_Plan = 1;

    my($caller) = caller;
    no strict 'refs';
    *{$caller.'::ok'} = \&ok;
}


unless( $^C ) {    
    $| = 1;
    open(*TESTOUT, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
    open(*TESTERR, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
    {
        my $orig_fh = select TESTOUT;
        $| = 1;
        select TESTERR;
        $| = 1;
        select $orig_fh;
    }
}

=head1 NAME

Test::Simple - Basic utilities for writing tests.

=head1 SYNOPSIS

  use Test::Simple tests => 1;

  ok( $foo eq $bar, 'foo is bar' );


=head1 DESCRIPTION

** If you are unfamiliar with testing B<read Test::Tutorial> first! **

This is an extremely simple, extremely basic module for writing tests
suitable for CPAN modules and other pursuits.  If you wish to do more
complicated testing, use the Test::More module (a drop-in replacement
for this one).

The basic unit of Perl testing is the ok.  For each thing you want to
test your program will print out an "ok" or "not ok" to indicate pass
or fail.  You do this with the ok() function (see below).

The only other constraint is you must predeclare how many tests you
plan to run.  This is in case something goes horribly wrong during the
test and your test program aborts, or skips a test or whatever.  You
do this like so:

    use Test::Simple tests => 23;

You must have a plan.


=over 4

=item B<ok>

  ok( $foo eq $bar, $name );
  ok( $foo eq $bar );

ok() is given an expression (in this case C<$foo eq $bar>).  If its
true, the test passed.  If its false, it didn't.  That's about it.

ok() prints out either "ok" or "not ok" along with a test number (it
keeps track of that for you).

  # This produces "ok 1 - Hell not yet frozen over" (or not ok)
  ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );

If you provide a $name, that will be printed along with the "ok/not
ok" to make it easier to find your test when if fails (just search for
the name).  It also makes it easier for the next guy to understand
what your test is for.  Its highly recommended you use test names.

All tests are run in scalar context.  So this:

    ok( @stuff, 'I have some stuff' );

will do what you mean (fail if stuff is empty)

=cut

sub ok ($;$) {
    my($test, $name) = @_;

    unless( $Have_Plan ) {
        die "You tried to use ok() without a plan!  Gotta have a plan.\n".
            "  use Test::Simple tests => 23;   for example.\n";
    }

    $Num_Tests++;

    my_print *TESTERR, <<ERR if defined $name and $name =~ /^[\d\s]+$/;
You named your test '$name'.  You shouldn't use numbers for your test names.
Very confusing.
ERR


    my($pack, $file, $line) = caller;
    # temporary special case for Test::More & Parrot::Test's calls.
    if( $pack eq 'Test::More' || $pack eq 'Parrot::Test' ) {
        ($pack, $file, $line) = caller(1);
    }

    my($is_todo)  = ${$pack.'::TODO'} ? 1 : 0;

    # We must print this all in one shot or else it will break on VMS
    my $msg;
    unless( $test ) {
        $msg .= "not ";
        $Test_Results[$Num_Tests-1] = $is_todo ? 1 : 0;
    }
    else {
        $Test_Results[$Num_Tests-1] = 1;
    }
    $msg   .= "ok $Num_Tests";

    if( defined $name ) {
        $name =~ s|#|\\#|g;     # # in a name can confuse Test::Harness.
        $msg   .= " - $name";
    }
    if( $is_todo ) {
        my $what_todo = ${$pack.'::TODO'};
        $msg   .= " # TODO $what_todo";
    }
    $msg   .= "\n";

    my_print *TESTOUT, $msg;

    #'#
    unless( $test ) {
        my $msg = $is_todo ? "Failed (TODO)" : "Failed";
        my_print *TESTERR, "#     $msg test ($file at line $line)\n";
    }

    return $test ? 1 : 0;
}


sub _skipped {
    my($why) = shift;

    unless( $Have_Plan ) {
        die "You tried to use ok() without a plan!  Gotta have a plan.\n".
            "  use Test::Simple tests => 23;   for example.\n";
    }

    $Num_Tests++;

    # XXX Set this to "Skip" instead?
    $Test_Results[$Num_Tests-1] = 1;

    # We must print this all in one shot or else it will break on VMS
    my $msg;
    $msg   .= "ok $Num_Tests # skip $why\n";

    my_print *TESTOUT, $msg;

    return 1;
}


=back

Test::Simple will start by printing number of tests run in the form
"1..M" (so "1..5" means you're going to run 5 tests).  This strange
format lets Test::Harness know how many tests you plan on running in
case something goes horribly wrong.

If all your tests passed, Test::Simple will exit with zero (which is
normal).  If anything failed it will exit with how many failed.  If
you run less (or more) tests than you planned, the missing (or extras)
will be considered failures.  If no tests were ever run Test::Simple
will throw a warning and exit with 255.  If the test died, even after
having successfully completed all its tests, it will still be
considered a failure and will exit with 255.

So the exit codes are...

    0                   all tests successful
    255                 test died
    any other number    how many failed (including missing or extras)

If you fail more than 254 tests, it will be reported as 254.

=begin _private

=over 4

=item B<_sanity_check>

  _sanity_check();

Runs a bunch of end of test sanity checks to make sure reality came
through ok.  If anything is wrong it will die with a fairly friendly
error message.

=cut

#'#
sub _sanity_check {
    _whoa($Num_Tests < 0,  'Says here you ran a negative number of tests!');
    _whoa(!$Have_Plan and $Num_Tests, 
          'Somehow your tests ran without a plan!');
    _whoa($Num_Tests != @Test_Results,
          'Somehow you got a different number of results than tests ran!');
}

=item B<_whoa>

  _whoa($check, $description);

A sanity check, similar to assert().  If the $check is true, something
has gone horribly wrong.  It will die with the given $description and
a note to contact the author.

=cut

sub _whoa {
    my($check, $desc) = @_;
    if( $check ) {
        die <<WHOA;
WHOA!  $desc
This should never happen!  Please contact the author immediately!
WHOA
    }
}

=item B<_my_exit>

  _my_exit($exit_num);

Perl seems to have some trouble with exiting inside an END block.  5.005_03
and 5.6.1 both seem to do odd things.  Instead, this function edits $?
directly.  It should ONLY be called from inside an END block.  It
doesn't actually exit, that's your job.

=cut

sub _my_exit {
    $? = $_[0];

    return 1;
}


=back

=end _private

=cut

$SIG{__DIE__} = sub {
    # We don't want to muck with death in an eval, but $^S isn't
    # totally reliable.  5.005_03 and 5.6.1 both do the wrong thing
    # with it.  Instead, we use caller.  This also means it runs under
    # 5.004!
    my $in_eval = 0;
    for( my $stack = 1;  my $sub = (caller($stack))[3];  $stack++ ) {
        $in_eval = 1 if $sub =~ /^\(eval\)/;
    }
    $Test_Died = 1 unless $in_eval;
};

END {
    _sanity_check();

    # Bailout if import() was never called.  This is so
    # "require Test::Simple" doesn't puke.
    do{ _my_exit(0) && return } if !$Have_Plan and !$Num_Tests;

    # Figure out if we passed or failed and print helpful messages.
    if( $Num_Tests ) {
        # The plan?  We have no plan.
        unless( $Planned_Tests ) {
            my_print *TESTOUT, "1..$Num_Tests\n";
            $Planned_Tests = $Num_Tests;
        }

        my $num_failed = grep !$_, @Test_Results[0..$Planned_Tests-1];
        $num_failed += abs($Planned_Tests - @Test_Results);

        if( $Num_Tests < $Planned_Tests ) {
            my_print *TESTERR, <<"FAIL";
# Looks like you planned $Planned_Tests tests but only ran $Num_Tests.
FAIL
        }
        elsif( $Num_Tests > $Planned_Tests ) {
            my $num_extra = $Num_Tests - $Planned_Tests;
            my_print *TESTERR, <<"FAIL";
# Looks like you planned $Planned_Tests tests but ran $num_extra extra.
FAIL
        }
        elsif ( $num_failed ) {
            my_print *TESTERR, <<"FAIL";
# Looks like you failed $num_failed tests of $Planned_Tests.
FAIL
        }

        if( $Test_Died ) {
            my_print *TESTERR, <<"FAIL";
# Looks like your test died just after $Num_Tests.
FAIL

            _my_exit( 255 ) && return;
        }

        _my_exit( $num_failed <= 254 ? $num_failed : 254  ) && return;
    }
    elsif ( $Test::Simple::Skip_All ) {
        _my_exit( 0 ) && return;
    }
    else {
        my_print *TESTERR, "# No tests run!\n";
        _my_exit( 255 ) && return;
    }
}


=pod

This module is by no means trying to be a complete testing system.
Its just to get you started.  Once you're off the ground its
recommended you look at L<Test::More>.


=head1 EXAMPLE

Here's an example of a simple .t file for the fictional Film module.

    use Test::Simple tests => 5;

    use Film;  # What you're testing.

    my $btaste = Film->new({ Title    => 'Bad Taste',
                             Director => 'Peter Jackson',
                             Rating   => 'R',
                             NumExplodingSheep => 1
                           });
    ok( defined($btaste) and ref $btaste eq 'Film',     'new() works' );

    ok( $btaste->Title      eq 'Bad Taste',     'Title() get'    );
    ok( $btaste->Director   eq 'Peter Jackson', 'Director() get' );
    ok( $btaste->Rating     eq 'R',             'Rating() get'   );
    ok( $btaste->NumExplodingSheep == 1,        'NumExplodingSheep() get' );

It will produce output like this:

    1..5
    ok 1 - new() works
    ok 2 - Title() get
    ok 3 - Director() get
    not ok 4 - Rating() get
    #    Failed test (t/film.t at line 14)
    ok 5 - NumExplodingSheep() get
    # Looks like you failed 1 tests of 5

Indicating the Film::Rating() method is broken.


=head1 CAVEATS

Test::Simple will only report a maximum of 254 failures in its exit
code.  If this is a problem, you probably have a huge test script.
Split it into multiple files.  (Otherwise blame the Unix folks for
using an unsigned short integer as the exit status).

Because VMS's exit codes are much, much different than the rest of the
universe, and perl does horrible mangling to them that gets in my way,
it works like this on VMS.

    0     SS$_NORMAL        all tests successful
    4     SS$_ABORT         something went wrong

Unfortunately, I can't differentiate any further.


=head1 NOTES

Test::Simple is B<explicitly> tested all the way back to perl 5.004.


=head1 HISTORY

This module was conceived while talking with Tony Bowden in his
kitchen one night about the problems I was having writing some really
complicated feature into the new Testing module.  He observed that the
main problem is not dealing with these edge cases but that people hate
to write tests B<at all>.  What was needed was a dead simple module
that took all the hard work out of testing and was really, really easy
to learn.  Paul Johnson simultaneously had this idea (unfortunately,
he wasn't in Tony's kitchen).  This is it.


=head1 AUTHOR

Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.


=head1 SEE ALSO

=over 4

=item L<Test::More>

More testing functions!  Once you outgrow Test::Simple, look at
Test::More.  Test::Simple is 100% forward compatible with Test::More
(ie. you can just use Test::More instead of Test::Simple in your
programs and things will still work).

=item L<Test>

The original Perl testing module.

=item L<Test::Unit>

Elaborate unit testing.

=item L<Pod::Tests>, L<SelfTest>

Embed tests in your code!

=item L<Test::Harness>

Interprets the output of your test program.

=back

=cut

1;
Commit	Line	Data
4dd974da	1	package Test::Simple;
4dd974da	2
d020a79a	3	use 5.004;
4dd974da	4
d020a79a	5	use strict 'vars';
	6	use Test::Utils;
	7
	8	use vars qw($VERSION);
	9
0cd946aa	10	$VERSION = '0.19';
4dd974da	11
	12	my(@Test_Results) = ();
	13	my($Num_Tests, $Planned_Tests, $Test_Died) = (0,0,0);
	14	my($Have_Plan) = 0;
	15
d020a79a	16	my $IsVMS = $^O eq 'VMS';
4dd974da	17
	18
	19	# I'd like to have Test::Simple interfere with the program being
	20	# tested as little as possible. This includes using Exporter or
	21	# anything else (including strict).
	22	sub import {
	23	# preserve caller()
	24	if( @_ > 1 ) {
	25	if( $_[1] eq 'no_plan' ) {
	26	goto &no_plan;
	27	}
	28	else {
	29	goto &plan
	30	}
	31	}
	32	}
	33
	34	sub plan {
	35	my($class, %config) = @_;
	36
	37	if( !exists $config{tests} ) {
	38	die "You have to tell $class how many tests you plan to run.\n".
	39	" use $class tests => 42; for example.\n";
	40	}
	41	elsif( !defined $config{tests} ) {
	42	die "Got an undefined number of tests. Looks like you tried to tell ".
	43	"$class how many tests you plan to run but made a mistake.\n";
	44	}
	45	elsif( !$config{tests} ) {
	46	die "You told $class you plan to run 0 tests! You've got to run ".
	47	"something.\n";
	48	}
	49	else {
	50	$Planned_Tests = $config{tests};
	51	}
	52
	53	$Have_Plan = 1;
	54
d020a79a	55	my_print *TESTOUT, "1..$Planned_Tests\n";
4dd974da	56
d020a79a	57	no strict 'refs';
4dd974da	58	my($caller) = caller;
4dd974da	59	*{$caller.'::ok'} = \&ok;
d020a79a	60
4dd974da	61	}
	62
	63
	64	sub no_plan {
	65	$Have_Plan = 1;
	66
	67	my($caller) = caller;
d020a79a	68	no strict 'refs';
4dd974da	69	*{$caller.'::ok'} = \&ok;
	70	}
	71
	72
b62cd5ea	73	unless( $^C ) {
4dd974da	74	$\| = 1;
b62cd5ea	75	open(*TESTOUT, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
	76	open(*TESTERR, ">&STDOUT") or _whoa(1, "Can't dup STDOUT!");
	77	{
	78	my $orig_fh = select TESTOUT;
	79	$\| = 1;
	80	select TESTERR;
	81	$\| = 1;
	82	select $orig_fh;
	83	}
4dd974da	84	}
	85
	86	=head1 NAME
	87
	88	Test::Simple - Basic utilities for writing tests.
	89
	90	=head1 SYNOPSIS
	91
	92	use Test::Simple tests => 1;
	93
	94	ok( $foo eq $bar, 'foo is bar' );
	95
	96
	97	=head1 DESCRIPTION
	98
d020a79a	99	If you are unfamiliar with testing B<read Test::Tutorial> first!
d020a79a	100
4dd974da	101	This is an extremely simple, extremely basic module for writing tests
d020a79a	102	suitable for CPAN modules and other pursuits. If you wish to do more
	103	complicated testing, use the Test::More module (a drop-in replacement
	104	for this one).
4dd974da	105
	106	The basic unit of Perl testing is the ok. For each thing you want to
	107	test your program will print out an "ok" or "not ok" to indicate pass
	108	or fail. You do this with the ok() function (see below).
	109
	110	The only other constraint is you must predeclare how many tests you
	111	plan to run. This is in case something goes horribly wrong during the
	112	test and your test program aborts, or skips a test or whatever. You
	113	do this like so:
	114
	115	use Test::Simple tests => 23;
	116
	117	You must have a plan.
	118
	119
	120	=over 4
	121
	122	=item B<ok>
	123
	124	ok( $foo eq $bar, $name );
	125	ok( $foo eq $bar );
	126
	127	ok() is given an expression (in this case C<$foo eq $bar>). If its
	128	true, the test passed. If its false, it didn't. That's about it.
	129
	130	ok() prints out either "ok" or "not ok" along with a test number (it
	131	keeps track of that for you).
	132
	133	# This produces "ok 1 - Hell not yet frozen over" (or not ok)
	134	ok( get_temperature($hell) > 0, 'Hell not yet frozen over' );
	135
	136	If you provide a $name, that will be printed along with the "ok/not
	137	ok" to make it easier to find your test when if fails (just search for
	138	the name). It also makes it easier for the next guy to understand
	139	what your test is for. Its highly recommended you use test names.
	140
	141	All tests are run in scalar context. So this:
	142
	143	ok( @stuff, 'I have some stuff' );
	144
d020a79a	145	will do what you mean (fail if stuff is empty)
4dd974da	146
	147	=cut
	148
	149	sub ok ($;$) {
	150	my($test, $name) = @_;
	151
	152	unless( $Have_Plan ) {
	153	die "You tried to use ok() without a plan! Gotta have a plan.\n".
	154	" use Test::Simple tests => 23; for example.\n";
	155	}
	156
	157	$Num_Tests++;
	158
0cd946aa	159	my_print *TESTERR, <<ERR if defined $name and $name =~ /^[\d\s]+$/;
4dd974da	160	You named your test '$name'. You shouldn't use numbers for your test names.
	161	Very confusing.
	162	ERR
	163
	164
d020a79a	165	my($pack, $file, $line) = caller;
0cd946aa	166	# temporary special case for Test::More & Parrot::Test's calls.
0cd946aa	167	if( $pack eq 'Test::More' \|\| $pack eq 'Parrot::Test' ) {
d020a79a	168	($pack, $file, $line) = caller(1);
	169	}
	170
	171	my($is_todo) = ${$pack.'::TODO'} ? 1 : 0;
	172
4dd974da	173	# We must print this all in one shot or else it will break on VMS
	174	my $msg;
	175	unless( $test ) {
	176	$msg .= "not ";
d020a79a	177	$Test_Results[$Num_Tests-1] = $is_todo ? 1 : 0;
4dd974da	178	}
	179	else {
	180	$Test_Results[$Num_Tests-1] = 1;
	181	}
	182	$msg .= "ok $Num_Tests";
d020a79a	183
0cd946aa	184	if( defined $name ) {
d020a79a	185	$name =~ s\|#\|\\#\|g; # # in a name can confuse Test::Harness.
	186	$msg .= " - $name";
	187	}
	188	if( $is_todo ) {
	189	my $what_todo = ${$pack.'::TODO'};
	190	$msg .= " # TODO $what_todo";
	191	}
4dd974da	192	$msg .= "\n";
4dd974da	193
d020a79a	194	my_print *TESTOUT, $msg;
4dd974da	195
4dd974da	196	#'#
0cd946aa	197	unless( $test ) {
	198	my $msg = $is_todo ? "Failed (TODO)" : "Failed";
	199	my_print *TESTERR, "# $msg test ($file at line $line)\n";
4dd974da	200	}
4dd974da	201
d020a79a	202	return $test ? 1 : 0;
4dd974da	203	}
4dd974da	204
d020a79a	205
	206	sub _skipped {
	207	my($why) = shift;
	208
	209	unless( $Have_Plan ) {
	210	die "You tried to use ok() without a plan! Gotta have a plan.\n".
	211	" use Test::Simple tests => 23; for example.\n";
	212	}
	213
	214	$Num_Tests++;
	215
	216	# XXX Set this to "Skip" instead?
	217	$Test_Results[$Num_Tests-1] = 1;
	218
	219	# We must print this all in one shot or else it will break on VMS
	220	my $msg;
	221	$msg .= "ok $Num_Tests # skip $why\n";
	222
	223	my_print *TESTOUT, $msg;
	224
	225	return 1;
	226	}
	227
	228
4dd974da	229	=back
	230
	231	Test::Simple will start by printing number of tests run in the form
	232	"1..M" (so "1..5" means you're going to run 5 tests). This strange
	233	format lets Test::Harness know how many tests you plan on running in
	234	case something goes horribly wrong.
	235
	236	If all your tests passed, Test::Simple will exit with zero (which is
	237	normal). If anything failed it will exit with how many failed. If
	238	you run less (or more) tests than you planned, the missing (or extras)
	239	will be considered failures. If no tests were ever run Test::Simple
	240	will throw a warning and exit with 255. If the test died, even after
	241	having successfully completed all its tests, it will still be
	242	considered a failure and will exit with 255.
	243
	244	So the exit codes are...
	245
	246	0 all tests successful
	247	255 test died
	248	any other number how many failed (including missing or extras)
	249
	250	If you fail more than 254 tests, it will be reported as 254.
	251
	252	=begin _private
	253
	254	=over 4
	255
	256	=item B<_sanity_check>
	257
	258	_sanity_check();
	259
	260	Runs a bunch of end of test sanity checks to make sure reality came
	261	through ok. If anything is wrong it will die with a fairly friendly
	262	error message.
	263
	264	=cut
	265
	266	#'#
	267	sub _sanity_check {
	268	_whoa($Num_Tests < 0, 'Says here you ran a negative number of tests!');
	269	_whoa(!$Have_Plan and $Num_Tests,
	270	'Somehow your tests ran without a plan!');
	271	_whoa($Num_Tests != @Test_Results,
	272	'Somehow you got a different number of results than tests ran!');
	273	}
	274
	275	=item B<_whoa>
	276
	277	_whoa($check, $description);
	278
	279	A sanity check, similar to assert(). If the $check is true, something
	280	has gone horribly wrong. It will die with the given $description and
	281	a note to contact the author.
	282
	283	=cut
	284
	285	sub _whoa {
	286	my($check, $desc) = @_;
	287	if( $check ) {
	288	die <<WHOA;
	289	WHOA! $desc
	290	This should never happen! Please contact the author immediately!
	291	WHOA
	292	}
293	}
294
295	=item B<_my_exit>
296
297	_my_exit($exit_num);
298
299	Perl seems to have some trouble with exiting inside an END block. 5.005_03
300	and 5.6.1 both seem to do odd things. Instead, this function edits $?
301	directly. It should ONLY be called from inside an END block. It
302	doesn't actually exit, that's your job.
303
304	=cut
305
306	sub _my_exit {
d020a79a	307	$? = $_[0];
	308
	309	return 1;
4dd974da	310	}
	311
	312
	313	=back
	314
	315	=end _private
	316
	317	=cut
	318
	319	$SIG{__DIE__} = sub {
	320	# We don't want to muck with death in an eval, but $^S isn't
	321	# totally reliable. 5.005_03 and 5.6.1 both do the wrong thing
	322	# with it. Instead, we use caller. This also means it runs under
	323	# 5.004!
	324	my $in_eval = 0;
	325	for( my $stack = 1; my $sub = (caller($stack))[3]; $stack++ ) {
	326	$in_eval = 1 if $sub =~ /^\(eval\)/;
	327	}
	328	$Test_Died = 1 unless $in_eval;
	329	};
	330
	331	END {
	332	_sanity_check();
	333
	334	# Bailout if import() was never called. This is so
	335	# "require Test::Simple" doesn't puke.
	336	do{ _my_exit(0) && return } if !$Have_Plan and !$Num_Tests;
	337
	338	# Figure out if we passed or failed and print helpful messages.
	339	if( $Num_Tests ) {
	340	# The plan? We have no plan.
	341	unless( $Planned_Tests ) {
d020a79a	342	my_print *TESTOUT, "1..$Num_Tests\n";
4dd974da	343	$Planned_Tests = $Num_Tests;
	344	}
	345
	346	my $num_failed = grep !$_, @Test_Results[0..$Planned_Tests-1];
	347	$num_failed += abs($Planned_Tests - @Test_Results);
	348
	349	if( $Num_Tests < $Planned_Tests ) {
d020a79a	350	my_print *TESTERR, <<"FAIL";
4dd974da	351	# Looks like you planned $Planned_Tests tests but only ran $Num_Tests.
	352	FAIL
	353	}
	354	elsif( $Num_Tests > $Planned_Tests ) {
	355	my $num_extra = $Num_Tests - $Planned_Tests;
d020a79a	356	my_print *TESTERR, <<"FAIL";
4dd974da	357	# Looks like you planned $Planned_Tests tests but ran $num_extra extra.
	358	FAIL
	359	}
	360	elsif ( $num_failed ) {
d020a79a	361	my_print *TESTERR, <<"FAIL";
4dd974da	362	# Looks like you failed $num_failed tests of $Planned_Tests.
	363	FAIL
	364	}
	365
	366	if( $Test_Died ) {
d020a79a	367	my_print *TESTERR, <<"FAIL";
4dd974da	368	# Looks like your test died just after $Num_Tests.
	369	FAIL
	370
	371	_my_exit( 255 ) && return;
	372	}
	373
	374	_my_exit( $num_failed <= 254 ? $num_failed : 254 ) && return;
	375	}
	376	elsif ( $Test::Simple::Skip_All ) {
	377	_my_exit( 0 ) && return;
	378	}
	379	else {
d020a79a	380	my_print *TESTERR, "# No tests run!\n";
4dd974da	381	_my_exit( 255 ) && return;
	382	}
	383	}
	384
	385
	386	=pod
	387
	388	This module is by no means trying to be a complete testing system.
	389	Its just to get you started. Once you're off the ground its
	390	recommended you look at L<Test::More>.
	391
	392
	393	=head1 EXAMPLE
	394
	395	Here's an example of a simple .t file for the fictional Film module.
	396
	397	use Test::Simple tests => 5;
	398
	399	use Film; # What you're testing.
	400
	401	my $btaste = Film->new({ Title => 'Bad Taste',
	402	Director => 'Peter Jackson',
	403	Rating => 'R',
	404	NumExplodingSheep => 1
	405	});
	406	ok( defined($btaste) and ref $btaste eq 'Film', 'new() works' );
	407
	408	ok( $btaste->Title eq 'Bad Taste', 'Title() get' );
d020a79a	409	ok( $btaste->Director eq 'Peter Jackson', 'Director() get' );
4dd974da	410	ok( $btaste->Rating eq 'R', 'Rating() get' );
	411	ok( $btaste->NumExplodingSheep == 1, 'NumExplodingSheep() get' );
	412
	413	It will produce output like this:
	414
	415	1..5
	416	ok 1 - new() works
	417	ok 2 - Title() get
	418	ok 3 - Director() get
	419	not ok 4 - Rating() get
d020a79a	420	# Failed test (t/film.t at line 14)
4dd974da	421	ok 5 - NumExplodingSheep() get
d020a79a	422	# Looks like you failed 1 tests of 5
4dd974da	423
	424	Indicating the Film::Rating() method is broken.
	425
	426
	427	=head1 CAVEATS
	428
	429	Test::Simple will only report a maximum of 254 failures in its exit
	430	code. If this is a problem, you probably have a huge test script.
	431	Split it into multiple files. (Otherwise blame the Unix folks for
	432	using an unsigned short integer as the exit status).
	433
d020a79a	434	Because VMS's exit codes are much, much different than the rest of the
	435	universe, and perl does horrible mangling to them that gets in my way,
	436	it works like this on VMS.
	437
	438	0 SS$_NORMAL all tests successful
	439	4 SS$_ABORT something went wrong
	440
	441	Unfortunately, I can't differentiate any further.
	442
	443
	444	=head1 NOTES
	445
	446	Test::Simple is B<explicitly> tested all the way back to perl 5.004.
	447
4dd974da	448
	449	=head1 HISTORY
	450
	451	This module was conceived while talking with Tony Bowden in his
	452	kitchen one night about the problems I was having writing some really
	453	complicated feature into the new Testing module. He observed that the
	454	main problem is not dealing with these edge cases but that people hate
	455	to write tests B<at all>. What was needed was a dead simple module
	456	that took all the hard work out of testing and was really, really easy
	457	to learn. Paul Johnson simultaneously had this idea (unfortunately,
	458	he wasn't in Tony's kitchen). This is it.
	459
	460
	461	=head1 AUTHOR
	462
	463	Idea by Tony Bowden and Paul Johnson, code by Michael G Schwern
d020a79a	464	E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
4dd974da	465
	466
	467	=head1 SEE ALSO
	468
	469	=over 4
	470
	471	=item L<Test::More>
	472
	473	More testing functions! Once you outgrow Test::Simple, look at
	474	Test::More. Test::Simple is 100% forward compatible with Test::More
	475	(ie. you can just use Test::More instead of Test::Simple in your
	476	programs and things will still work).
	477
	478	=item L<Test>
	479
	480	The original Perl testing module.
	481
	482	=item L<Test::Unit>
	483
	484	Elaborate unit testing.
	485
	486	=item L<Pod::Tests>, L<SelfTest>
	487
	488	Embed tests in your code!
	489
	490	=item L<Test::Harness>
	491
	492	Interprets the output of your test program.
	493
	494	=back
	495
	496	=cut
	497
	498	1;