Commit | Line | Data |
---|---|---|
4dd974da JH |
1 | package Test::Simple; |
2 | ||
3 | require 5.004; | |
4 | ||
11ea77c5 | 5 | $Test::Simple::VERSION = '0.09'; |
4dd974da JH |
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; |