Commit | Line | Data |
809908f7 |
1 | |
2 | require 5.004; |
75fa620a |
3 | package Test; |
4 | # Time-stamp: "2002-08-26 03:09:51 MDT" |
809908f7 |
5 | |
6 | use strict; |
7 | |
7b13a3f5 |
8 | use Carp; |
809908f7 |
9 | use vars (qw($VERSION @ISA @EXPORT @EXPORT_OK $ntest $TestLevel), #public-ish |
75fa620a |
10 | qw($TESTOUT $TESTERR %Program_Lines |
711cdd39 |
11 | $ONFAIL %todo %history $planned @FAILDETAIL) #private-ish |
809908f7 |
12 | ); |
13 | |
711cdd39 |
14 | # In case a test is run in a persistent environment. |
15 | sub _reset_globals { |
16 | %todo = (); |
17 | %history = (); |
18 | @FAILDETAIL = (); |
19 | $ntest = 1; |
20 | $TestLevel = 0; # how many extra stack frames to skip |
21 | $planned = 0; |
22 | } |
23 | |
75fa620a |
24 | $VERSION = '1.21'; |
7b13a3f5 |
25 | require Exporter; |
26 | @ISA=('Exporter'); |
809908f7 |
27 | |
28 | @EXPORT = qw(&plan &ok &skip); |
711cdd39 |
29 | @EXPORT_OK = qw($ntest $TESTOUT $TESTERR); |
7b13a3f5 |
30 | |
31 | $|=1; |
f2ac83ee |
32 | $TESTOUT = *STDOUT{IO}; |
711cdd39 |
33 | $TESTERR = *STDERR{IO}; |
7b13a3f5 |
34 | |
3238f5fe |
35 | # Use of this variable is strongly discouraged. It is set mainly to |
36 | # help test coverage analyzers know which test is running. |
7b13a3f5 |
37 | $ENV{REGRESSION_TEST} = $0; |
38 | |
809908f7 |
39 | |
40 | =head1 NAME |
41 | |
42 | Test - provides a simple framework for writing test scripts |
43 | |
44 | =head1 SYNOPSIS |
45 | |
46 | use strict; |
47 | use Test; |
48 | |
49 | # use a BEGIN block so we print our plan before MyModule is loaded |
50 | BEGIN { plan tests => 14, todo => [3,4] } |
51 | |
52 | # load your module... |
53 | use MyModule; |
54 | |
75fa620a |
55 | # Helpful notes. All note-lines must start with a "#". |
56 | print "# I'm testing MyModule version $MyModule::VERSION\n"; |
57 | |
809908f7 |
58 | ok(0); # failure |
59 | ok(1); # success |
60 | |
61 | ok(0); # ok, expected failure (see todo list, above) |
62 | ok(1); # surprise success! |
63 | |
64 | ok(0,1); # failure: '0' ne '1' |
65 | ok('broke','fixed'); # failure: 'broke' ne 'fixed' |
66 | ok('fixed','fixed'); # success: 'fixed' eq 'fixed' |
67 | ok('fixed',qr/x/); # success: 'fixed' =~ qr/x/ |
68 | |
69 | ok(sub { 1+1 }, 2); # success: '2' eq '2' |
70 | ok(sub { 1+1 }, 3); # failure: '2' ne '3' |
809908f7 |
71 | |
72 | my @list = (0,0); |
75fa620a |
73 | ok @list, 3, "\@list=".join(',',@list); #extra notes |
809908f7 |
74 | ok 'segmentation fault', '/(?i)success/'; #regex match |
75 | |
75fa620a |
76 | skip( |
77 | $^O eq 'MSWin' ? "Not for MSWin" : 0, # whether to skip |
78 | $foo, $bar # arguments just like for ok(...) |
79 | ); |
809908f7 |
80 | |
81 | =head1 DESCRIPTION |
82 | |
75fa620a |
83 | This module simplifies the task of writing test files for Perl modules, |
84 | such that their output is in the format that |
85 | L<Test::Harness|Test::Harness> expects to see. |
edd5bad5 |
86 | |
75fa620a |
87 | =head1 QUICK START GUIDE |
809908f7 |
88 | |
75fa620a |
89 | To write a test for your new (and probably not even done) module, create |
90 | a new file called F<t/test.t> (in a new F<t> directory). If you have |
91 | multiple test files, to test the "foo", "bar", and "baz" feature sets, |
92 | then feel free to call your files F<t/foo.t>, F<t/bar.t>, and |
93 | F<t/baz.t> |
809908f7 |
94 | |
95 | =head2 Functions |
96 | |
75fa620a |
97 | This module defines three public functions, C<plan(...)>, C<ok(...)>, |
98 | and C<skip(...)>. By default, all three are exported by |
99 | the C<use Test;> statement. |
809908f7 |
100 | |
101 | =over 4 |
102 | |
75fa620a |
103 | =item C<plan(...)> |
809908f7 |
104 | |
105 | BEGIN { plan %theplan; } |
106 | |
107 | This should be the first thing you call in your test script. It |
108 | declares your testing plan, how many there will be, if any of them |
75fa620a |
109 | should be allowed to fail, and so on. |
809908f7 |
110 | |
111 | Typical usage is just: |
112 | |
113 | use Test; |
114 | BEGIN { plan tests => 23 } |
115 | |
75fa620a |
116 | These are the things that you can put in the parameters to plan: |
117 | |
118 | =over |
119 | |
120 | =item C<tests =E<gt> I<number>> |
121 | |
122 | The number of tests in your script. |
123 | This means all ok() and skip() calls. |
124 | |
125 | =item C<todo =E<gt> [I<1,5,14>]> |
126 | |
127 | A reference to a list of tests which are allowed to fail. |
128 | See L</TODO TESTS>. |
129 | |
130 | =item C<onfail =E<gt> sub { ... }> |
809908f7 |
131 | |
75fa620a |
132 | =item C<onfail =E<gt> \&some_sub> |
809908f7 |
133 | |
75fa620a |
134 | A subroutine reference to be run at the end of the test script, if |
135 | any of the tests fail. See L</ONFAIL>. |
136 | |
137 | =back |
138 | |
139 | You must call C<plan(...)> once and only once. You should call it |
140 | in a C<BEGIN {...}> block, like so: |
141 | |
142 | BEGIN { plan tests => 23 } |
809908f7 |
143 | |
144 | =cut |
145 | |
7b13a3f5 |
146 | sub plan { |
147 | croak "Test::plan(%args): odd number of arguments" if @_ & 1; |
8b3be1d1 |
148 | croak "Test::plan(): should not be called more than once" if $planned; |
809908f7 |
149 | |
150 | local($\, $,); # guard against -l and other things that screw with |
151 | # print |
152 | |
711cdd39 |
153 | _reset_globals(); |
154 | |
75fa620a |
155 | _read_program( (caller)[1] ); |
156 | |
7b13a3f5 |
157 | my $max=0; |
158 | for (my $x=0; $x < @_; $x+=2) { |
159 | my ($k,$v) = @_[$x,$x+1]; |
160 | if ($k =~ /^test(s)?$/) { $max = $v; } |
161 | elsif ($k eq 'todo' or |
162 | $k eq 'failok') { for (@$v) { $todo{$_}=1; }; } |
8b3be1d1 |
163 | elsif ($k eq 'onfail') { |
164 | ref $v eq 'CODE' or croak "Test::plan(onfail => $v): must be CODE"; |
165 | $ONFAIL = $v; |
166 | } |
7b13a3f5 |
167 | else { carp "Test::plan(): skipping unrecognized directive '$k'" } |
168 | } |
169 | my @todo = sort { $a <=> $b } keys %todo; |
170 | if (@todo) { |
f2ac83ee |
171 | print $TESTOUT "1..$max todo ".join(' ', @todo).";\n"; |
7b13a3f5 |
172 | } else { |
f2ac83ee |
173 | print $TESTOUT "1..$max\n"; |
7b13a3f5 |
174 | } |
8b3be1d1 |
175 | ++$planned; |
75fa620a |
176 | print $TESTOUT "# Running under perl version $] for $^O", |
177 | (chr(65) eq 'A') ? "\n" : " in a non-ASCII world\n"; |
178 | |
179 | print $TESTOUT "# Win32::BuildNumber ", &Win32::BuildNumber(), "\n" |
180 | if defined(&Win32::BuildNumber) and defined &Win32::BuildNumber(); |
181 | |
182 | print $TESTOUT "# MacPerl verison $MacPerl::Version\n" |
183 | if defined $MacPerl::Version; |
184 | |
185 | printf $TESTOUT |
186 | "# Current time local: %s\n# Current time GMT: %s\n", |
187 | scalar( gmtime($^T)), scalar(localtime($^T)); |
188 | |
189 | print $TESTOUT "# Using Test.pm version $VERSION\n"; |
809908f7 |
190 | |
75fa620a |
191 | # Retval never used: |
809908f7 |
192 | return undef; |
7b13a3f5 |
193 | } |
194 | |
75fa620a |
195 | sub _read_program { |
196 | my($file) = shift; |
197 | return unless defined $file and length $file |
198 | and -e $file and -f _ and -r _; |
199 | open(SOURCEFILE, "<$file") || return; |
200 | $Program_Lines{$file} = [<SOURCEFILE>]; |
201 | close(SOURCEFILE); |
202 | |
203 | foreach my $x (@{$Program_Lines{$file}}) |
204 | { $x =~ tr/[\cm\cj\n\r]//d } |
205 | |
206 | unshift @{$Program_Lines{$file}}, ''; |
207 | return 1; |
208 | } |
809908f7 |
209 | |
210 | =begin _private |
211 | |
212 | =item B<_to_value> |
213 | |
214 | my $value = _to_value($input); |
215 | |
75fa620a |
216 | Converts an C<ok> parameter to its value. Typically this just means |
217 | running it, if it's a code reference. You should run all inputted |
809908f7 |
218 | values through this. |
219 | |
220 | =cut |
221 | |
222 | sub _to_value { |
3238f5fe |
223 | my ($v) = @_; |
809908f7 |
224 | return (ref $v or '') eq 'CODE' ? $v->() : $v; |
3238f5fe |
225 | } |
226 | |
809908f7 |
227 | =end _private |
228 | |
75fa620a |
229 | =item C<ok(...)> |
809908f7 |
230 | |
231 | ok(1 + 1 == 2); |
232 | ok($have, $expect); |
233 | ok($have, $expect, $diagnostics); |
234 | |
75fa620a |
235 | This function is the reason for C<Test>'s existence. It's |
236 | the basic function that |
237 | handles printing "C<ok>" or "C<not ok>", along with the |
238 | current test number. (That's what C<Test::Harness> wants to see.) |
239 | |
240 | In its most basic usage, C<ok(...)> simply takes a single scalar |
241 | expression. If its value is true, the test passes; if false, |
242 | the test fails. Examples: |
809908f7 |
243 | |
75fa620a |
244 | # Examples of ok(scalar) |
809908f7 |
245 | |
246 | ok( 1 + 1 == 2 ); # ok if 1 + 1 == 2 |
247 | ok( $foo =~ /bar/ ); # ok if $foo contains 'bar' |
248 | ok( baz($x + $y) eq 'Armondo' ); # ok if baz($x + $y) returns |
249 | # 'Armondo' |
250 | ok( @a == @b ); # ok if @a and @b are the same length |
251 | |
252 | The expression is evaluated in scalar context. So the following will |
253 | work: |
254 | |
255 | ok( @stuff ); # ok if @stuff has any elements |
256 | ok( !grep !defined $_, @stuff ); # ok if everything in @stuff is |
257 | # defined. |
258 | |
75fa620a |
259 | A special case is if the expression is a subroutine reference (in either |
260 | C<sub {...}> syntax or C<\&foo> syntax). In |
809908f7 |
261 | that case, it is executed and its value (true or false) determines if |
75fa620a |
262 | the test passes or fails. For example, |
809908f7 |
263 | |
75fa620a |
264 | ok( sub { # See whether sleep works at least passably |
265 | my $start_time = time; |
266 | sleep 5; |
267 | time() - $start_time >= 4 |
268 | }); |
809908f7 |
269 | |
75fa620a |
270 | In its two-argument form, C<ok(I<arg1>,I<arg2>)> compares the two scalar |
271 | values to see if they equal. (The equality is checked with C<eq>). |
809908f7 |
272 | |
75fa620a |
273 | # Example of ok(scalar, scalar) |
274 | |
275 | ok( "this", "that" ); # not ok, 'this' ne 'that' |
809908f7 |
276 | |
75fa620a |
277 | If either (or both!) is a subroutine reference, it is run and used |
278 | as the value for comparing. For example: |
279 | |
280 | ok 4, sub { |
281 | open(OUT, ">x.dat") || die $!; |
282 | print OUT "\x{e000}"; |
283 | close OUT; |
284 | my $bytecount = -s 'x.dat'; |
285 | unlink 'x.dat' or warn "Can't unlink : $!"; |
286 | return $bytecount; |
287 | }, |
288 | ; |
289 | |
290 | The above test passes two values to C<ok(arg1, arg2)> -- the first is |
291 | the number 4, and the second is a coderef. Before C<ok> compares them, |
292 | it calls the coderef, and uses its return value as the real value of |
293 | this parameter. Assuming that C<$bytecount> returns 4, C<ok> ends up |
294 | testing C<4 eq 4>. Since that's true, this test passes. |
295 | |
296 | If C<arg2> is either a regex object (i.e., C<qr/.../>) or a string |
297 | that I<looks like> a regex (e.g., C<'/foo/'>), then |
298 | C<ok(I<arg1>,I<arg2>)> will perform a pattern |
299 | match against it, instead of using C<eq>. |
809908f7 |
300 | |
301 | ok( 'JaffO', '/Jaff/' ); # ok, 'JaffO' =~ /Jaff/ |
302 | ok( 'JaffO', qr/Jaff/ ); # ok, 'JaffO' =~ qr/Jaff/; |
303 | ok( 'JaffO', '/(?i)jaff/ ); # ok, 'JaffO' =~ /jaff/i; |
304 | |
75fa620a |
305 | Finally, you can append an optional third argument, in |
306 | C<ok(I<arg1>,I<arg2>, I<note>)>, where I<note> is a string value that |
307 | will be printed if the test fails. This should be some useful |
308 | information about the test, pertaining to why it failed, and/or |
309 | a description of the test. For example: |
809908f7 |
310 | |
311 | ok( grep($_ eq 'something unique', @stuff), 1, |
312 | "Something that should be unique isn't!\n". |
313 | '@stuff = '.join ', ', @stuff |
314 | ); |
315 | |
75fa620a |
316 | Unfortunately, a note cannot be used with the single argument |
317 | style of C<ok()>. That is, if you try C<ok(I<arg1>, I<note>)>, then |
318 | C<Test> will interpret this as C<ok(I<arg1>, I<arg2>)>, and probably |
319 | end up testing C<I<arg1> eq I<arg2>> -- and that's not what you want! |
809908f7 |
320 | |
75fa620a |
321 | All of the above special cases can occasionally cause some |
322 | problems. See L</BUGS and CAVEATS>. |
809908f7 |
323 | |
324 | =cut |
325 | |
75fa620a |
326 | # A past maintainer of this module said: |
327 | # <<ok(...)'s special handling of subroutine references is an unfortunate |
328 | # "feature" that can't be removed due to compatibility.>> |
329 | # |
330 | |
8b3be1d1 |
331 | sub ok ($;$$) { |
332 | croak "ok: plan before you test!" if !$planned; |
809908f7 |
333 | |
334 | local($\,$,); # guard against -l and other things that screw with |
335 | # print |
336 | |
3238f5fe |
337 | my ($pkg,$file,$line) = caller($TestLevel); |
338 | my $repetition = ++$history{"$file:$line"}; |
339 | my $context = ("$file at line $line". |
8b3be1d1 |
340 | ($repetition > 1 ? " fail \#$repetition" : '')); |
75fa620a |
341 | |
3238f5fe |
342 | my $ok=0; |
809908f7 |
343 | my $result = _to_value(shift); |
344 | my ($expected,$diag,$isregex,$regex); |
3238f5fe |
345 | if (@_ == 0) { |
8b3be1d1 |
346 | $ok = $result; |
3238f5fe |
347 | } else { |
809908f7 |
348 | $expected = _to_value(shift); |
59e80644 |
349 | if (!defined $expected) { |
350 | $ok = !defined $result; |
351 | } elsif (!defined $result) { |
352 | $ok = 0; |
353 | } elsif ((ref($expected)||'') eq 'Regexp') { |
f2ac83ee |
354 | $ok = $result =~ /$expected/; |
809908f7 |
355 | $regex = $expected; |
f2ac83ee |
356 | } elsif (($regex) = ($expected =~ m,^ / (.+) / $,sx) or |
809908f7 |
357 | (undef, $regex) = ($expected =~ m,^ m([^\w\s]) (.+) \1 $,sx)) { |
8b3be1d1 |
358 | $ok = $result =~ /$regex/; |
3238f5fe |
359 | } else { |
3238f5fe |
360 | $ok = $result eq $expected; |
361 | } |
8b3be1d1 |
362 | } |
f2ac83ee |
363 | my $todo = $todo{$ntest}; |
364 | if ($todo and $ok) { |
365 | $context .= ' TODO?!' if $todo; |
366 | print $TESTOUT "ok $ntest # ($context)\n"; |
8b3be1d1 |
367 | } else { |
809908f7 |
368 | # Issuing two seperate prints() causes problems on VMS. |
369 | if (!$ok) { |
370 | print $TESTOUT "not ok $ntest\n"; |
e5420382 |
371 | } |
809908f7 |
372 | else { |
373 | print $TESTOUT "ok $ntest\n"; |
e5420382 |
374 | } |
8b3be1d1 |
375 | |
376 | if (!$ok) { |
377 | my $detail = { 'repetition' => $repetition, 'package' => $pkg, |
f2ac83ee |
378 | 'result' => $result, 'todo' => $todo }; |
8b3be1d1 |
379 | $$detail{expected} = $expected if defined $expected; |
809908f7 |
380 | |
381 | # Get the user's diagnostic, protecting against multi-line |
382 | # diagnostics. |
383 | $diag = $$detail{diagnostic} = _to_value(shift) if @_; |
384 | $diag =~ s/\n/\n#/g if defined $diag; |
385 | |
f2ac83ee |
386 | $context .= ' *TODO*' if $todo; |
8b3be1d1 |
387 | if (!defined $expected) { |
3238f5fe |
388 | if (!$diag) { |
711cdd39 |
389 | print $TESTERR "# Failed test $ntest in $context\n"; |
3238f5fe |
390 | } else { |
711cdd39 |
391 | print $TESTERR "# Failed test $ntest in $context: $diag\n"; |
3238f5fe |
392 | } |
8b3be1d1 |
393 | } else { |
394 | my $prefix = "Test $ntest"; |
711cdd39 |
395 | print $TESTERR "# $prefix got: ". |
59e80644 |
396 | (defined $result? "'$result'":'<UNDEF>')." ($context)\n"; |
8b3be1d1 |
397 | $prefix = ' ' x (length($prefix) - 5); |
809908f7 |
398 | if (defined $regex) { |
399 | $expected = 'qr{'.$regex.'}'; |
400 | } |
401 | else { |
f2ac83ee |
402 | $expected = "'$expected'"; |
403 | } |
8b3be1d1 |
404 | if (!$diag) { |
711cdd39 |
405 | print $TESTERR "# $prefix Expected: $expected\n"; |
3238f5fe |
406 | } else { |
711cdd39 |
407 | print $TESTERR "# $prefix Expected: $expected ($diag)\n"; |
3238f5fe |
408 | } |
409 | } |
75fa620a |
410 | |
411 | if(defined $Program_Lines{$file}[$line]) { |
412 | print $TESTERR |
413 | "# $file line $line is: $Program_Lines{$file}[$line]\n" |
414 | if |
415 | $Program_Lines{$file}[$line] =~ m/[^\s\#\(\)\{\}\[\]\;]/ |
416 | # Otherwise it's a pretty uninteresting line! |
417 | ; |
418 | |
419 | undef $Program_Lines{$file}[$line]; |
420 | # So we won't repeat it. |
421 | } |
422 | |
8b3be1d1 |
423 | push @FAILDETAIL, $detail; |
7b13a3f5 |
424 | } |
7b13a3f5 |
425 | } |
426 | ++ $ntest; |
427 | $ok; |
428 | } |
429 | |
75fa620a |
430 | =item C<skip(I<skip_if_true>, I<args...>)> |
431 | |
432 | This is used for tests that under some conditions can be skipped. It's |
433 | basically equivalent to: |
434 | |
435 | if( $skip_if_true ) { |
436 | ok(1); |
437 | } else { |
438 | ok( args... ); |
439 | } |
440 | |
441 | ...except that the C<ok(1)> emits not just "C<ok I<testnum>>" but |
442 | actually "C<ok I<testnum> # I<skip_if_true_value>>". |
443 | |
444 | The arguments after the I<skip_if_true> are what is fed to C<ok(...)> if |
445 | this test isn't skipped. |
446 | |
447 | Example usage: |
448 | |
449 | my $if_MSWin = |
450 | $^O eq 'MSWin' ? 'Skip if under MSWin' : ''; |
451 | |
452 | # A test to be run EXCEPT under MSWin: |
453 | skip($if_MSWin, thing($foo), thing($bar) ); |
454 | |
455 | Or, going the other way: |
456 | |
457 | my $unless_MSWin = |
458 | $^O eq 'MSWin' ? 'Skip unless under MSWin' : ''; |
459 | |
460 | # A test to be run EXCEPT under MSWin: |
461 | skip($unless_MSWin, thing($foo), thing($bar) ); |
462 | |
463 | The only tricky thing to remember is that the first parameter is true if |
464 | you want to I<skip> the test, not I<run> it; and it also doubles as a |
465 | note about why it's being skipped. So in the first codeblock above, read |
466 | the code as "skip if MSWin -- (otherwise) test whether C<thing($foo)> is |
467 | C<thing($bar)>" or for the second case, "skip unless MSWin...". |
468 | |
469 | Also, when your I<skip_if_reason> string is true, it really should (for |
470 | backwards compatibility with older Test.pm versions) start with the |
471 | string "Skip", as shown in the above examples. |
472 | |
473 | Note that in the above cases, C<thing($foo)> and C<thing($bar)> |
474 | I<are> evaluated -- but as long as the C<skip_if_true> is true, |
475 | then we C<skip(...)> just tosses out their value (i.e., not |
476 | bothering to treat them like values to C<ok(...)>. But if |
477 | you need to I<not> eval the arguments when skipping the |
478 | test, use |
479 | this format: |
480 | |
481 | skip( $unless_MSWin, |
482 | sub { |
483 | # This code returns true if the test passes. |
484 | # (But it doesn't even get called if the test is skipped.) |
485 | thing($foo) eq thing($bar) |
486 | } |
487 | ); |
488 | |
489 | or even this, which is basically equivalent: |
490 | |
491 | skip( $unless_MSWin, |
492 | sub { thing($foo) }, sub { thing($bar) } |
493 | ); |
494 | |
495 | That is, both are like this: |
496 | |
497 | if( $unless_MSWin ) { |
498 | ok(1); # but it actually appends "# $unless_MSWin" |
499 | # so that Test::Harness can tell it's a skip |
500 | } else { |
501 | # Not skipping, so actually call and evaluate... |
502 | ok( sub { thing($foo) }, sub { thing($bar) } ); |
503 | } |
504 | |
505 | =cut |
506 | |
809908f7 |
507 | sub skip ($;$$$) { |
508 | local($\, $,); # guard against -l and other things that screw with |
509 | # print |
510 | |
511 | my $whyskip = _to_value(shift); |
512 | if (!@_ or $whyskip) { |
513 | $whyskip = '' if $whyskip =~ m/^\d+$/; |
514 | $whyskip =~ s/^[Ss]kip(?:\s+|$)//; # backwards compatibility, old |
515 | # versions required the reason |
516 | # to start with 'skip' |
517 | # We print in one shot for VMSy reasons. |
518 | my $ok = "ok $ntest # skip"; |
519 | $ok .= " $whyskip" if length $whyskip; |
520 | $ok .= "\n"; |
521 | print $TESTOUT $ok; |
522 | ++ $ntest; |
523 | return 1; |
7b13a3f5 |
524 | } else { |
809908f7 |
525 | # backwards compatiblity (I think). skip() used to be |
316cf57b |
526 | # called like ok(), which is weird. I haven't decided what to do with |
527 | # this yet. |
528 | # warn <<WARN if $^W; |
529 | #This looks like a skip() using the very old interface. Please upgrade to |
530 | #the documented interface as this has been deprecated. |
531 | #WARN |
809908f7 |
532 | |
75fa620a |
533 | local($TestLevel) = $TestLevel+1; #to ignore this stack frame |
809908f7 |
534 | return &ok(@_); |
7b13a3f5 |
535 | } |
536 | } |
537 | |
809908f7 |
538 | =back |
539 | |
540 | =cut |
541 | |
8b3be1d1 |
542 | END { |
543 | $ONFAIL->(\@FAILDETAIL) if @FAILDETAIL && $ONFAIL; |
544 | } |
545 | |
7b13a3f5 |
546 | 1; |
547 | __END__ |
548 | |
3238f5fe |
549 | =head1 TEST TYPES |
7b13a3f5 |
550 | |
551 | =over 4 |
552 | |
553 | =item * NORMAL TESTS |
554 | |
75fa620a |
555 | These tests are expected to succeed. Usually, most or all of your tests |
556 | are in this category. If a normal test doesn't succeed, then that |
557 | means that something is I<wrong>. |
7b13a3f5 |
558 | |
559 | =item * SKIPPED TESTS |
560 | |
75fa620a |
561 | The C<skip(...)> function is for tests that might or might not be |
562 | possible to run, depending |
563 | on the availability of platform-specific features. The first argument |
f2ac83ee |
564 | should evaluate to true (think "yes, please skip") if the required |
75fa620a |
565 | feature is I<not> available. After the first argument, C<skip(...)> works |
566 | exactly the same way as C<ok(...)> does. |
7b13a3f5 |
567 | |
568 | =item * TODO TESTS |
569 | |
f2ac83ee |
570 | TODO tests are designed for maintaining an B<executable TODO list>. |
75fa620a |
571 | These tests are I<expected to fail.> If a TODO test does succeed, |
572 | then the feature in question shouldn't be on the TODO list, now |
573 | should it? |
7b13a3f5 |
574 | |
f2ac83ee |
575 | Packages should NOT be released with succeeding TODO tests. As soon |
75fa620a |
576 | as a TODO test starts working, it should be promoted to a normal test, |
f2ac83ee |
577 | and the newly working feature should be documented in the release |
75fa620a |
578 | notes or in the change log. |
7b13a3f5 |
579 | |
580 | =back |
581 | |
8b3be1d1 |
582 | =head1 ONFAIL |
583 | |
584 | BEGIN { plan test => 4, onfail => sub { warn "CALL 911!" } } |
585 | |
75fa620a |
586 | Although test failures should be enough, extra diagnostics can be |
f2ac83ee |
587 | triggered at the end of a test run. C<onfail> is passed an array ref |
588 | of hash refs that describe each test failure. Each hash will contain |
589 | at least the following fields: C<package>, C<repetition>, and |
590 | C<result>. (The file, line, and test number are not included because |
f610777f |
591 | their correspondence to a particular test is tenuous.) If the test |
75fa620a |
592 | had an expected value or a diagnostic (or "note") string, these will also be |
f2ac83ee |
593 | included. |
594 | |
75fa620a |
595 | The I<optional> C<onfail> hook might be used simply to print out the |
f2ac83ee |
596 | version of your package and/or how to report problems. It might also |
597 | be used to generate extremely sophisticated diagnostics for a |
598 | particularly bizarre test failure. However it's not a panacea. Core |
599 | dumps or other unrecoverable errors prevent the C<onfail> hook from |
600 | running. (It is run inside an C<END> block.) Besides, C<onfail> is |
601 | probably over-kill in most cases. (Your test code should be simpler |
8b3be1d1 |
602 | than the code it is testing, yes?) |
603 | |
809908f7 |
604 | |
605 | =head1 BUGS and CAVEATS |
606 | |
75fa620a |
607 | =over |
608 | |
609 | =item * |
610 | |
611 | C<ok(...)>'s special handing of strings which look like they might be |
612 | regexes can also cause unexpected behavior. An innocent: |
613 | |
614 | ok( $fileglob, '/path/to/some/*stuff/' ); |
615 | |
616 | will fail, since Test.pm considers the second argument to be a regex! |
617 | The best bet is to use the one-argument form: |
618 | |
619 | ok( $fileglob eq '/path/to/some/*stuff/' ); |
809908f7 |
620 | |
75fa620a |
621 | =item * |
622 | |
623 | C<ok(...)>'s use of string C<eq> can sometimes cause odd problems |
624 | when comparing |
809908f7 |
625 | numbers, especially if you're casting a string to a number: |
626 | |
627 | $foo = "1.0"; |
628 | ok( $foo, 1 ); # not ok, "1.0" ne 1 |
629 | |
630 | Your best bet is to use the single argument form: |
631 | |
632 | ok( $foo == 1 ); # ok "1.0" == 1 |
633 | |
75fa620a |
634 | =item * |
809908f7 |
635 | |
75fa620a |
636 | As you may have inferred from the above documentation and examples, |
637 | C<ok>'s prototype is C<($;$$)> (and, incidentally, C<skip>'s is |
638 | C<($;$$$)>). This means, for example, that you can do C<ok @foo, @bar> |
639 | to compare the I<size> of the two arrays. But don't be fooled into |
640 | thinking that C<ok @foo, @bar> means a comparison of the contents of two |
641 | arrays -- you're comparing I<just> the number of elements of each. It's |
642 | so easy to make that mistake in reading C<ok @foo, @bar> that you might |
643 | want to be very explicit about it, and instead write C<ok scalar(@foo), |
644 | scalar(@bar)>. |
809908f7 |
645 | |
75fa620a |
646 | =back |
809908f7 |
647 | |
711cdd39 |
648 | =head1 NOTE |
809908f7 |
649 | |
75fa620a |
650 | A past developer of this module once said that it was no longer being |
651 | actively developed. However, rumors of its demise were greatly |
652 | exaggerated. Feedback and suggestions are quite welcome. |
653 | |
654 | Be aware that the main value of this module is its simplicity. Note |
655 | that there are already more ambitious modules out there, such as |
656 | L<Test::More> and L<Test::Unit>. |
809908f7 |
657 | |
658 | |
7b13a3f5 |
659 | =head1 SEE ALSO |
660 | |
75fa620a |
661 | L<Test::Harness> |
662 | |
663 | L<Test::Simple>, L<Test::More>, L<Devel::Cover> |
809908f7 |
664 | |
711cdd39 |
665 | L<Test::Builder> for building your own testing library. |
666 | |
667 | L<Test::Unit> is an interesting XUnit-style testing library. |
809908f7 |
668 | |
711cdd39 |
669 | L<Test::Inline> and L<SelfTest> let you embed tests in code. |
edd5bad5 |
670 | |
7b13a3f5 |
671 | |
672 | =head1 AUTHOR |
673 | |
809908f7 |
674 | Copyright (c) 1998-2000 Joshua Nathaniel Pritikin. All rights reserved. |
809908f7 |
675 | |
75fa620a |
676 | Copyright (c) 2001-2002 Michael G. Schwern. |
677 | |
678 | Copyright (c) 2002 Sean M. Burke. |
679 | |
680 | Current maintainer: Sean M. Burke. E<lt>sburke@cpan.orgE<gt> |
7b13a3f5 |
681 | |
682 | This package is free software and is provided "as is" without express |
683 | or implied warranty. It may be used, redistributed and/or modified |
711cdd39 |
684 | under the same terms as Perl itself. |
7b13a3f5 |
685 | |
686 | =cut |
75fa620a |
687 | |
688 | # "Your mistake was a hidden intention." |
689 | # -- /Oblique Strategies/, Brian Eno and Peter Schmidt |