lib/Test/Simple.pm

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