lib/Test/Simple.pm

   1 package Test::Simple;
   2
   3 use 5.004;
   4
   5 use strict 'vars';
   6 use Test::Utils;
   7
   8 use vars qw($VERSION);
   9
  10 $VERSION = '0.19';
  11
  12 my(@Test_Results) = ();
  13 my($Num_Tests, $Planned_Tests, $Test_Died) = (0,0,0);
  14 my($Have_Plan) = 0;
  15
  16 my $IsVMS = $^O eq 'VMS';
  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
  55     my_print *TESTOUT, "1..$Planned_Tests\n";
  56
  57     no strict 'refs';
  58     my($caller) = caller;
  59     *{$caller.'::ok'} = \&ok;
  60
  61 }
  62
  63
  64 sub no_plan {
  65     $Have_Plan = 1;
  66
  67     my($caller) = caller;
  68     no strict 'refs';
  69     *{$caller.'::ok'} = \&ok;
  70 }
  71
  72
  73 unless( $^C ) {
  74     $| = 1;
  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     }
  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
  99 ** If you are unfamiliar with testing B<read Test::Tutorial> first! **
 100
 101 This is an extremely simple, extremely basic module for writing tests
 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).
 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
 145 will do what you mean (fail if stuff is empty)
 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
 159     my_print *TESTERR, <<ERR if defined $name and $name =~ /^[\d\s]+$/;
 160 You named your test '$name'.  You shouldn't use numbers for your test names.
 161 Very confusing.
 162 ERR
 163
 164
 165     my($pack, $file, $line) = caller;
 166     # temporary special case for Test::More & Parrot::Test's calls.
 167     if( $pack eq 'Test::More' || $pack eq 'Parrot::Test' ) {
 168         ($pack, $file, $line) = caller(1);
 169     }
 170
 171     my($is_todo)  = ${$pack.'::TODO'} ? 1 : 0;
 172
 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 ";
 177         $Test_Results[$Num_Tests-1] = $is_todo ? 1 : 0;
 178     }
 179     else {
 180         $Test_Results[$Num_Tests-1] = 1;
 181     }
 182     $msg   .= "ok $Num_Tests";
 183
 184     if( defined $name ) {
 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     }
 192     $msg   .= "\n";
 193
 194     my_print *TESTOUT, $msg;
 195
 196     #'#
 197     unless( $test ) {
 198         my $msg = $is_todo ? "Failed (TODO)" : "Failed";
 199         my_print *TESTERR, "#     $msg test ($file at line $line)\n";
 200     }
 201
 202     return $test ? 1 : 0;
 203 }
 204
 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
 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 {
 307     $? = $_[0];
 308
 309     return 1;
 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 ) {
 342             my_print *TESTOUT, "1..$Num_Tests\n";
 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 ) {
 350             my_print *TESTERR, <<"FAIL";
 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;
 356             my_print *TESTERR, <<"FAIL";
 357 # Looks like you planned $Planned_Tests tests but ran $num_extra extra.
 358 FAIL
 359         }
 360         elsif ( $num_failed ) {
 361             my_print *TESTERR, <<"FAIL";
 362 # Looks like you failed $num_failed tests of $Planned_Tests.
 363 FAIL
 364         }
 365
 366         if( $Test_Died ) {
 367             my_print *TESTERR, <<"FAIL";
 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 {
 380         my_print *TESTERR, "# No tests run!\n";
 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'    );
 409     ok( $btaste->Director   eq 'Peter Jackson', 'Director() get' );
 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
 420     #    Failed test (t/film.t at line 14)
 421     ok 5 - NumExplodingSheep() get
 422     # Looks like you failed 1 tests of 5
 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
 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
 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
 464 E<lt>schwern@pobox.comE<gt>, wardrobe by Calvin Klein.
 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;