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