Commit | Line | Data |
4dd974da |
1 | package Test::Simple; |
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; |
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! ** |
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. |
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"; |
193 | |
d020a79a |
194 | my_print *TESTOUT, $msg; |
4dd974da |
195 | |
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 | } |
201 | |
d020a79a |
202 | return $test ? 1 : 0; |
4dd974da |
203 | } |
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; |