Commit | Line | Data |
---|---|---|
3f2ec160 JH |
1 | package Test::More; |
2 | ||
d020a79a | 3 | use 5.004; |
3f2ec160 | 4 | |
d020a79a JH |
5 | use strict; |
6 | use Carp; | |
7 | use Test::Utils; | |
3f2ec160 JH |
8 | |
9 | BEGIN { | |
10 | require Test::Simple; | |
11 | *TESTOUT = \*Test::Simple::TESTOUT; | |
12 | *TESTERR = \*Test::Simple::TESTERR; | |
13 | } | |
14 | ||
15 | require Exporter; | |
1dea78b9 | 16 | use vars qw($VERSION @ISA @EXPORT $TODO); |
0cd946aa | 17 | $VERSION = '0.19'; |
3f2ec160 JH |
18 | @ISA = qw(Exporter); |
19 | @EXPORT = qw(ok use_ok require_ok | |
20 | is isnt like | |
21 | skip todo | |
22 | pass fail | |
23 | eq_array eq_hash eq_set | |
d020a79a JH |
24 | skip |
25 | $TODO | |
26 | plan | |
27 | can_ok isa_ok | |
3f2ec160 JH |
28 | ); |
29 | ||
30 | ||
31 | sub import { | |
32 | my($class, $plan, @args) = @_; | |
33 | ||
d020a79a JH |
34 | if( defined $plan ) { |
35 | if( $plan eq 'skip_all' ) { | |
36 | $Test::Simple::Skip_All = 1; | |
37 | my $out = "1..0"; | |
38 | $out .= " # Skip @args" if @args; | |
39 | $out .= "\n"; | |
40 | ||
41 | my_print *TESTOUT, $out; | |
42 | exit(0); | |
43 | } | |
44 | else { | |
45 | Test::Simple->import($plan => @args); | |
46 | } | |
3f2ec160 JH |
47 | } |
48 | else { | |
d020a79a | 49 | Test::Simple->import; |
3f2ec160 JH |
50 | } |
51 | ||
52 | __PACKAGE__->_export_to_level(1, __PACKAGE__); | |
53 | } | |
54 | ||
55 | # 5.004's Exporter doesn't have export_to_level. | |
56 | sub _export_to_level | |
57 | { | |
58 | my $pkg = shift; | |
59 | my $level = shift; | |
60 | (undef) = shift; # XXX redundant arg | |
61 | my $callpkg = caller($level); | |
62 | $pkg->export($callpkg, @_); | |
63 | } | |
64 | ||
65 | ||
66 | =head1 NAME | |
67 | ||
68 | Test::More - yet another framework for writing test scripts | |
69 | ||
70 | =head1 SYNOPSIS | |
71 | ||
72 | use Test::More tests => $Num_Tests; | |
73 | # or | |
74 | use Test::More qw(no_plan); | |
75 | # or | |
d020a79a | 76 | use Test::More skip_all => $reason; |
3f2ec160 JH |
77 | |
78 | BEGIN { use_ok( 'Some::Module' ); } | |
79 | require_ok( 'Some::Module' ); | |
80 | ||
81 | # Various ways to say "ok" | |
82 | ok($this eq $that, $test_name); | |
83 | ||
84 | is ($this, $that, $test_name); | |
85 | isnt($this, $that, $test_name); | |
86 | like($this, qr/that/, $test_name); | |
87 | ||
d020a79a JH |
88 | SKIP: { |
89 | skip $why, $how_many unless $have_some_feature; | |
90 | ||
3f2ec160 JH |
91 | ok( foo(), $test_name ); |
92 | is( foo(42), 23, $test_name ); | |
d020a79a JH |
93 | }; |
94 | ||
95 | TODO: { | |
96 | local $TODO = $why; | |
3f2ec160 | 97 | |
3f2ec160 JH |
98 | ok( foo(), $test_name ); |
99 | is( foo(42), 23, $test_name ); | |
d020a79a JH |
100 | }; |
101 | ||
102 | can_ok($module, @methods); | |
103 | isa_ok($object, $class); | |
3f2ec160 JH |
104 | |
105 | pass($test_name); | |
106 | fail($test_name); | |
107 | ||
108 | # Utility comparison functions. | |
109 | eq_array(\@this, \@that); | |
110 | eq_hash(\%this, \%that); | |
111 | eq_set(\@this, \@that); | |
112 | ||
113 | # UNIMPLEMENTED!!! | |
114 | my @status = Test::More::status; | |
115 | ||
d020a79a JH |
116 | # UNIMPLEMENTED!!! |
117 | BAIL_OUT($why); | |
118 | ||
3f2ec160 JH |
119 | |
120 | =head1 DESCRIPTION | |
121 | ||
122 | If you're just getting started writing tests, have a look at | |
d020a79a JH |
123 | Test::Simple first. This is a drop in replacement for Test::Simple |
124 | which you can switch to once you get the hang of basic testing. | |
3f2ec160 JH |
125 | |
126 | This module provides a very wide range of testing utilities. Various | |
127 | ways to say "ok", facilities to skip tests, test future features | |
128 | and compare complicated data structures. | |
129 | ||
130 | ||
131 | =head2 I love it when a plan comes together | |
132 | ||
133 | Before anything else, you need a testing plan. This basically declares | |
134 | how many tests your script is going to run to protect against premature | |
135 | failure. | |
136 | ||
137 | The prefered way to do this is to declare a plan when you C<use Test::More>. | |
138 | ||
139 | use Test::More tests => $Num_Tests; | |
140 | ||
141 | There are rare cases when you will not know beforehand how many tests | |
142 | your script is going to run. In this case, you can declare that you | |
143 | have no plan. (Try to avoid using this as it weakens your test.) | |
144 | ||
145 | use Test::More qw(no_plan); | |
146 | ||
147 | In some cases, you'll want to completely skip an entire testing script. | |
148 | ||
d020a79a | 149 | use Test::More skip_all => $skip_reason; |
3f2ec160 | 150 | |
d020a79a JH |
151 | Your script will declare a skip with the reason why you skipped and |
152 | exit immediately with a zero (success). See L<Test::Harness> for | |
153 | details. | |
3f2ec160 JH |
154 | |
155 | ||
156 | =head2 Test names | |
157 | ||
158 | By convention, each test is assigned a number in order. This is | |
159 | largely done automatically for you. However, its often very useful to | |
160 | assign a name to each test. Which would you rather see: | |
161 | ||
162 | ok 4 | |
163 | not ok 5 | |
164 | ok 6 | |
165 | ||
166 | or | |
167 | ||
168 | ok 4 - basic multi-variable | |
169 | not ok 5 - simple exponential | |
170 | ok 6 - force == mass * acceleration | |
171 | ||
172 | The later gives you some idea of what failed. It also makes it easier | |
173 | to find the test in your script, simply search for "simple | |
174 | exponential". | |
175 | ||
176 | All test functions take a name argument. Its optional, but highly | |
177 | suggested that you use it. | |
178 | ||
179 | ||
180 | =head2 I'm ok, you're not ok. | |
181 | ||
182 | The basic purpose of this module is to print out either "ok #" or "not | |
183 | ok #" depending on if a given test succeeded or failed. Everything | |
184 | else is just gravy. | |
185 | ||
186 | All of the following print "ok" or "not ok" depending on if the test | |
187 | succeeded or failed. They all also return true or false, | |
188 | respectively. | |
189 | ||
190 | =over 4 | |
191 | ||
192 | =item B<ok> | |
193 | ||
194 | ok($this eq $that, $test_name); | |
195 | ||
196 | This simply evaluates any expression (C<$this eq $that> is just a | |
197 | simple example) and uses that to determine if the test succeeded or | |
198 | failed. A true expression passes, a false one fails. Very simple. | |
199 | ||
200 | For example: | |
201 | ||
202 | ok( $exp{9} == 81, 'simple exponential' ); | |
203 | ok( Film->can('db_Main'), 'set_db()' ); | |
204 | ok( $p->tests == 4, 'saw tests' ); | |
205 | ok( !grep !defined $_, @items, 'items populated' ); | |
206 | ||
207 | (Mnemonic: "This is ok.") | |
208 | ||
209 | $test_name is a very short description of the test that will be printed | |
210 | out. It makes it very easy to find a test in your script when it fails | |
211 | and gives others an idea of your intentions. $test_name is optional, | |
212 | but we B<very> strongly encourage its use. | |
213 | ||
214 | Should an ok() fail, it will produce some diagnostics: | |
215 | ||
216 | not ok 18 - sufficient mucus | |
217 | # Failed test 18 (foo.t at line 42) | |
218 | ||
219 | This is actually Test::Simple's ok() routine. | |
220 | ||
221 | =cut | |
222 | ||
223 | # We get ok() from Test::Simple's import(). | |
224 | ||
225 | =item B<is> | |
226 | ||
227 | =item B<isnt> | |
228 | ||
229 | is ( $this, $that, $test_name ); | |
230 | isnt( $this, $that, $test_name ); | |
231 | ||
d020a79a JH |
232 | Similar to ok(), is() and isnt() compare their two arguments |
233 | with C<eq> and C<ne> respectively and use the result of that to | |
234 | determine if the test succeeded or failed. So these: | |
3f2ec160 JH |
235 | |
236 | # Is the ultimate answer 42? | |
237 | is( ultimate_answer(), 42, "Meaning of Life" ); | |
238 | ||
239 | # $foo isn't empty | |
240 | isnt( $foo, '', "Got some foo" ); | |
241 | ||
242 | are similar to these: | |
243 | ||
244 | ok( ultimate_answer() eq 42, "Meaning of Life" ); | |
245 | ok( $foo ne '', "Got some foo" ); | |
246 | ||
247 | (Mnemonic: "This is that." "This isn't that.") | |
248 | ||
249 | So why use these? They produce better diagnostics on failure. ok() | |
250 | cannot know what you are testing for (beyond the name), but is() and | |
251 | isnt() know what the test was and why it failed. For example this | |
d020a79a | 252 | test: |
3f2ec160 JH |
253 | |
254 | my $foo = 'waffle'; my $bar = 'yarblokos'; | |
255 | is( $foo, $bar, 'Is foo the same as bar?' ); | |
256 | ||
257 | Will produce something like this: | |
258 | ||
259 | not ok 17 - Is foo the same as bar? | |
260 | # Failed test 1 (foo.t at line 139) | |
261 | # got: 'waffle' | |
262 | # expected: 'yarblokos' | |
263 | ||
264 | So you can figure out what went wrong without rerunning the test. | |
265 | ||
266 | You are encouraged to use is() and isnt() over ok() where possible, | |
267 | however do not be tempted to use them to find out if something is | |
268 | true or false! | |
269 | ||
270 | # XXX BAD! $pope->isa('Catholic') eq 1 | |
271 | is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' ); | |
272 | ||
273 | This does not check if C<$pope->isa('Catholic')> is true, it checks if | |
274 | it returns 1. Very different. Similar caveats exist for false and 0. | |
275 | In these cases, use ok(). | |
276 | ||
277 | ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' ); | |
278 | ||
d020a79a JH |
279 | For those grammatical pedants out there, there's an C<isn't()> |
280 | function which is an alias of isnt(). | |
3f2ec160 JH |
281 | |
282 | =cut | |
283 | ||
284 | sub is ($$;$) { | |
285 | my($this, $that, $name) = @_; | |
286 | ||
d020a79a JH |
287 | my $test; |
288 | { | |
289 | local $^W = 0; # so is(undef, undef) works quietly. | |
290 | $test = $this eq $that; | |
291 | } | |
292 | my $ok = @_ == 3 ? ok($test, $name) | |
293 | : ok($test); | |
3f2ec160 JH |
294 | |
295 | unless( $ok ) { | |
d020a79a JH |
296 | $this = defined $this ? "'$this'" : 'undef'; |
297 | $that = defined $that ? "'$that'" : 'undef'; | |
298 | my_print *TESTERR, sprintf <<DIAGNOSTIC, $this, $that; | |
299 | # got: %s | |
300 | # expected: %s | |
3f2ec160 JH |
301 | DIAGNOSTIC |
302 | ||
303 | } | |
304 | ||
305 | return $ok; | |
306 | } | |
307 | ||
308 | sub isnt ($$;$) { | |
309 | my($this, $that, $name) = @_; | |
310 | ||
d020a79a JH |
311 | my $test; |
312 | { | |
313 | local $^W = 0; # so isnt(undef, undef) works quietly. | |
314 | $test = $this ne $that; | |
315 | } | |
316 | ||
317 | my $ok = @_ == 3 ? ok($test, $name) | |
318 | : ok($test); | |
3f2ec160 JH |
319 | |
320 | unless( $ok ) { | |
d020a79a JH |
321 | $that = defined $that ? "'$that'" : 'undef'; |
322 | ||
323 | my_print *TESTERR, sprintf <<DIAGNOSTIC, $that; | |
324 | # it should not be %s | |
3f2ec160 JH |
325 | # but it is. |
326 | DIAGNOSTIC | |
327 | ||
328 | } | |
329 | ||
330 | return $ok; | |
331 | } | |
332 | ||
333 | *isn't = \&isnt; | |
334 | ||
335 | ||
336 | =item B<like> | |
337 | ||
338 | like( $this, qr/that/, $test_name ); | |
339 | ||
340 | Similar to ok(), like() matches $this against the regex C<qr/that/>. | |
341 | ||
342 | So this: | |
343 | ||
344 | like($this, qr/that/, 'this is like that'); | |
345 | ||
346 | is similar to: | |
347 | ||
348 | ok( $this =~ /that/, 'this is like that'); | |
349 | ||
350 | (Mnemonic "This is like that".) | |
351 | ||
352 | The second argument is a regular expression. It may be given as a | |
d020a79a | 353 | regex reference (ie. C<qr//>) or (for better compatibility with older |
3f2ec160 JH |
354 | perls) as a string that looks like a regex (alternative delimiters are |
355 | currently not supported): | |
356 | ||
357 | like( $this, '/that/', 'this is like that' ); | |
358 | ||
359 | Regex options may be placed on the end (C<'/that/i'>). | |
360 | ||
361 | Its advantages over ok() are similar to that of is() and isnt(). Better | |
362 | diagnostics on failure. | |
363 | ||
364 | =cut | |
365 | ||
366 | sub like ($$;$) { | |
367 | my($this, $regex, $name) = @_; | |
368 | ||
369 | my $ok = 0; | |
370 | if( ref $regex eq 'Regexp' ) { | |
d020a79a | 371 | local $^W = 0; |
3f2ec160 JH |
372 | $ok = @_ == 3 ? ok( $this =~ $regex ? 1 : 0, $name ) |
373 | : ok( $this =~ $regex ? 1 : 0 ); | |
374 | } | |
375 | # Check if it looks like '/foo/i' | |
376 | elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) { | |
d020a79a | 377 | local $^W = 0; |
3f2ec160 JH |
378 | $ok = @_ == 3 ? ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name ) |
379 | : ok( $this =~ /(?$opts)$re/ ? 1 : 0 ); | |
380 | } | |
381 | else { | |
382 | # Can't use fail() here, the call stack will be fucked. | |
383 | my $ok = @_ == 3 ? ok(0, $name ) | |
384 | : ok(0); | |
385 | ||
d020a79a | 386 | my_print *TESTERR, <<ERR; |
3f2ec160 JH |
387 | # '$regex' doesn't look much like a regex to me. Failing the test. |
388 | ERR | |
389 | ||
390 | return $ok; | |
391 | } | |
392 | ||
393 | unless( $ok ) { | |
d020a79a JH |
394 | $this = defined $this ? "'$this'" : 'undef'; |
395 | my_print *TESTERR, sprintf <<DIAGNOSTIC, $this; | |
396 | # %s | |
3f2ec160 JH |
397 | # doesn't match '$regex' |
398 | DIAGNOSTIC | |
399 | ||
400 | } | |
401 | ||
402 | return $ok; | |
403 | } | |
404 | ||
d020a79a JH |
405 | =item B<can_ok> |
406 | ||
407 | can_ok($module, @methods); | |
408 | can_ok($object, @methods); | |
409 | ||
410 | Checks to make sure the $module or $object can do these @methods | |
411 | (works with functions, too). | |
412 | ||
413 | can_ok('Foo', qw(this that whatever)); | |
414 | ||
415 | is almost exactly like saying: | |
416 | ||
417 | ok( Foo->can('this') && | |
418 | Foo->can('that') && | |
419 | Foo->can('whatever') | |
420 | ); | |
421 | ||
422 | only without all the typing and with a better interface. Handy for | |
423 | quickly testing an interface. | |
424 | ||
425 | =cut | |
426 | ||
427 | sub can_ok ($@) { | |
428 | my($proto, @methods) = @_; | |
429 | my $class= ref $proto || $proto; | |
430 | ||
431 | my @nok = (); | |
432 | foreach my $method (@methods) { | |
433 | my $test = "$class->can('$method')"; | |
434 | eval $test || push @nok, $method; | |
435 | } | |
436 | ||
437 | my $name; | |
438 | $name = @methods == 1 ? "$class->can($methods[0])" | |
439 | : "$class->can(...)"; | |
440 | ||
441 | ok( !@nok, $name ); | |
442 | ||
443 | my_print *TESTERR, map "# $class->can('$_') failed\n", @nok; | |
444 | ||
445 | return !@nok; | |
446 | } | |
447 | ||
448 | =item B<isa_ok> | |
449 | ||
450 | isa_ok($object, $class); | |
451 | ||
452 | Checks to see if the given $object->isa($class). Also checks to make | |
453 | sure the object was defined in the first place. Handy for this sort | |
454 | of thing: | |
455 | ||
456 | my $obj = Some::Module->new; | |
457 | isa_ok( $obj, 'Some::Module' ); | |
458 | ||
459 | where you'd otherwise have to write | |
460 | ||
461 | my $obj = Some::Module->new; | |
462 | ok( defined $obj && $obj->isa('Some::Module') ); | |
463 | ||
464 | to safeguard against your test script blowing up. | |
465 | ||
466 | =cut | |
467 | ||
468 | sub isa_ok ($$) { | |
469 | my($object, $class) = @_; | |
470 | ||
471 | my $diag; | |
472 | my $name = "object->isa('$class')"; | |
473 | if( !defined $object ) { | |
474 | $diag = "The object isn't defined"; | |
475 | } | |
476 | elsif( !ref $object ) { | |
477 | $diag = "The object isn't a reference"; | |
478 | } | |
479 | elsif( !$object->isa($class) ) { | |
480 | $diag = "The object isn't a '$class'"; | |
481 | } | |
482 | ||
483 | if( $diag ) { | |
484 | ok( 0, $name ); | |
485 | my_print *TESTERR, "# $diag\n"; | |
486 | return 0; | |
487 | } | |
488 | else { | |
489 | ok( 1, $name ); | |
490 | return 1; | |
491 | } | |
492 | } | |
493 | ||
494 | ||
3f2ec160 JH |
495 | =item B<pass> |
496 | ||
497 | =item B<fail> | |
498 | ||
499 | pass($test_name); | |
500 | fail($test_name); | |
501 | ||
502 | Sometimes you just want to say that the tests have passed. Usually | |
503 | the case is you've got some complicated condition that is difficult to | |
504 | wedge into an ok(). In this case, you can simply use pass() (to | |
505 | declare the test ok) or fail (for not ok). They are synonyms for | |
506 | ok(1) and ok(0). | |
507 | ||
508 | Use these very, very, very sparingly. | |
509 | ||
510 | =cut | |
511 | ||
d020a79a | 512 | sub pass (;$) { |
3f2ec160 JH |
513 | my($name) = @_; |
514 | return @_ == 1 ? ok(1, $name) | |
515 | : ok(1); | |
516 | } | |
517 | ||
d020a79a | 518 | sub fail (;$) { |
3f2ec160 JH |
519 | my($name) = @_; |
520 | return @_ == 1 ? ok(0, $name) | |
521 | : ok(0); | |
522 | } | |
523 | ||
524 | =back | |
525 | ||
526 | =head2 Module tests | |
527 | ||
528 | You usually want to test if the module you're testing loads ok, rather | |
529 | than just vomiting if its load fails. For such purposes we have | |
530 | C<use_ok> and C<require_ok>. | |
531 | ||
532 | =over 4 | |
533 | ||
534 | =item B<use_ok> | |
535 | ||
3f2ec160 | 536 | BEGIN { use_ok($module); } |
d020a79a JH |
537 | BEGIN { use_ok($module, @imports); } |
538 | ||
539 | These simply use the given $module and test to make sure the load | |
540 | happened ok. Its recommended that you run use_ok() inside a BEGIN | |
541 | block so its functions are exported at compile-time and prototypes are | |
542 | properly honored. | |
543 | ||
544 | If @imports are given, they are passed through to the use. So this: | |
545 | ||
546 | BEGIN { use_ok('Some::Module', qw(foo bar)) } | |
547 | ||
548 | is like doing this: | |
549 | ||
550 | use Some::Module qw(foo bar); | |
3f2ec160 | 551 | |
3f2ec160 JH |
552 | |
553 | =cut | |
554 | ||
d020a79a JH |
555 | sub use_ok ($;@) { |
556 | my($module, @imports) = @_; | |
557 | @imports = () unless @imports; | |
3f2ec160 JH |
558 | |
559 | my $pack = caller; | |
560 | ||
561 | eval <<USE; | |
562 | package $pack; | |
563 | require $module; | |
d020a79a | 564 | $module->import(\@imports); |
3f2ec160 JH |
565 | USE |
566 | ||
567 | my $ok = ok( !$@, "use $module;" ); | |
568 | ||
569 | unless( $ok ) { | |
0cd946aa | 570 | chomp $@; |
d020a79a | 571 | my_print *TESTERR, <<DIAGNOSTIC; |
3f2ec160 JH |
572 | # Tried to use '$module'. |
573 | # Error: $@ | |
574 | DIAGNOSTIC | |
575 | ||
576 | } | |
577 | ||
578 | return $ok; | |
579 | } | |
580 | ||
d020a79a JH |
581 | =item B<require_ok> |
582 | ||
583 | require_ok($module); | |
584 | ||
585 | Like use_ok(), except it requires the $module. | |
586 | ||
587 | =cut | |
3f2ec160 JH |
588 | |
589 | sub require_ok ($) { | |
590 | my($module) = shift; | |
591 | ||
592 | my $pack = caller; | |
593 | ||
594 | eval <<REQUIRE; | |
595 | package $pack; | |
596 | require $module; | |
597 | REQUIRE | |
598 | ||
599 | my $ok = ok( !$@, "require $module;" ); | |
600 | ||
601 | unless( $ok ) { | |
0cd946aa | 602 | chomp $@; |
d020a79a | 603 | my_print *TESTERR, <<DIAGNOSTIC; |
3f2ec160 JH |
604 | # Tried to require '$module'. |
605 | # Error: $@ | |
606 | DIAGNOSTIC | |
607 | ||
608 | } | |
609 | ||
610 | return $ok; | |
611 | } | |
612 | ||
d020a79a | 613 | =back |
3f2ec160 JH |
614 | |
615 | =head2 Conditional tests | |
616 | ||
d020a79a JH |
617 | B<WARNING!> The following describes an I<experimental> interface that |
618 | is subject to change B<WITHOUT NOTICE>! Use at your peril. | |
619 | ||
3f2ec160 JH |
620 | Sometimes running a test under certain conditions will cause the |
621 | test script to die. A certain function or method isn't implemented | |
622 | (such as fork() on MacOS), some resource isn't available (like a | |
d020a79a JH |
623 | net connection) or a module isn't available. In these cases it's |
624 | necessary to skip tests, or declare that they are supposed to fail | |
3f2ec160 JH |
625 | but will work in the future (a todo test). |
626 | ||
d020a79a JH |
627 | For more details on skip and todo tests see L<Test::Harness>. |
628 | ||
629 | The way Test::More handles this is with a named block. Basically, a | |
630 | block of tests which can be skipped over or made todo. It's best if I | |
631 | just show you... | |
3f2ec160 JH |
632 | |
633 | =over 4 | |
634 | ||
d020a79a JH |
635 | =item B<SKIP: BLOCK> |
636 | ||
637 | SKIP: { | |
638 | skip $why, $how_many if $condition; | |
3f2ec160 | 639 | |
d020a79a JH |
640 | ...normal testing code goes here... |
641 | } | |
3f2ec160 | 642 | |
d020a79a JH |
643 | This declares a block of tests to skip, $how_many tests there are, |
644 | $why and under what $condition to skip them. An example is the | |
645 | easiest way to illustrate: | |
3f2ec160 | 646 | |
d020a79a JH |
647 | SKIP: { |
648 | skip "Pigs don't fly here", 2 unless Pigs->can('fly'); | |
3f2ec160 | 649 | |
d020a79a JH |
650 | my $pig = Pigs->new; |
651 | $pig->takeoff; | |
652 | ||
653 | ok( $pig->altitude > 0, 'Pig is airborne' ); | |
654 | ok( $pig->airspeed > 0, ' and moving' ); | |
655 | } | |
3f2ec160 | 656 | |
d020a79a JH |
657 | If pigs cannot fly, the whole block of tests will be skipped |
658 | completely. Test::More will output special ok's which Test::Harness | |
659 | interprets as skipped tests. Its important to include $how_many tests | |
660 | are in the block so the total number of tests comes out right (unless | |
661 | you're using C<no_plan>). | |
662 | ||
663 | You'll typically use this when a feature is missing, like an optional | |
664 | module is not installed or the operating system doesn't have some | |
665 | feature (like fork() or symlinks) or maybe you need an Internet | |
666 | connection and one isn't available. | |
667 | ||
668 | =for _Future | |
669 | See L</Why are skip and todo so weird?> | |
3f2ec160 JH |
670 | |
671 | =cut | |
672 | ||
d020a79a | 673 | #'# |
1af51bd3 | 674 | sub skip { |
d020a79a JH |
675 | my($why, $how_many) = @_; |
676 | unless( $how_many >= 1 ) { | |
677 | # $how_many can only be avoided when no_plan is in use. | |
678 | carp "skip() needs to know \$how_many tests are in the block" | |
679 | if $Test::Simple::Planned_Tests; | |
680 | $how_many = 1; | |
681 | } | |
682 | ||
683 | for( 1..$how_many ) { | |
684 | Test::Simple::_skipped($why); | |
685 | } | |
686 | ||
687 | local $^W = 0; | |
688 | last SKIP; | |
3f2ec160 JH |
689 | } |
690 | ||
3f2ec160 | 691 | |
d020a79a | 692 | =item B<TODO: BLOCK> |
3f2ec160 | 693 | |
d020a79a JH |
694 | TODO: { |
695 | local $TODO = $why; | |
3f2ec160 | 696 | |
d020a79a JH |
697 | ...normal testing code goes here... |
698 | } | |
3f2ec160 | 699 | |
d020a79a JH |
700 | Declares a block of tests you expect to fail and $why. Perhaps it's |
701 | because you haven't fixed a bug or haven't finished a new feature: | |
3f2ec160 | 702 | |
d020a79a JH |
703 | TODO: { |
704 | local $TODO = "URI::Geller not finished"; | |
3f2ec160 | 705 | |
d020a79a JH |
706 | my $card = "Eight of clubs"; |
707 | is( URI::Geller->your_card, $card, 'Is THIS your card?' ); | |
3f2ec160 | 708 | |
d020a79a JH |
709 | my $spoon; |
710 | URI::Geller->bend_spoon; | |
711 | is( $spoon, 'bent', "Spoon bending, that's original" ); | |
712 | } | |
713 | ||
714 | With a todo block, the tests inside are expected to fail. Test::More | |
715 | will run the tests normally, but print out special flags indicating | |
716 | they are "todo". Test::Harness will interpret failures as being ok. | |
717 | Should anything succeed, it will report it as an unexpected success. | |
718 | ||
719 | The nice part about todo tests, as opposed to simply commenting out a | |
720 | block of tests, is it's like having a programatic todo list. You know | |
721 | how much work is left to be done, you're aware of what bugs there are, | |
722 | and you'll know immediately when they're fixed. | |
723 | ||
724 | Once a todo test starts succeeding, simply move it outside the block. | |
725 | When the block is empty, delete it. | |
726 | ||
727 | ||
728 | =back | |
3f2ec160 JH |
729 | |
730 | =head2 Comparision functions | |
731 | ||
732 | Not everything is a simple eq check or regex. There are times you | |
733 | need to see if two arrays are equivalent, for instance. For these | |
734 | instances, Test::More provides a handful of useful functions. | |
735 | ||
736 | B<NOTE> These are NOT well-tested on circular references. Nor am I | |
737 | quite sure what will happen with filehandles. | |
738 | ||
739 | =over 4 | |
740 | ||
741 | =item B<eq_array> | |
742 | ||
743 | eq_array(\@this, \@that); | |
744 | ||
745 | Checks if two arrays are equivalent. This is a deep check, so | |
746 | multi-level structures are handled correctly. | |
747 | ||
748 | =cut | |
749 | ||
750 | #'# | |
751 | sub eq_array { | |
752 | my($a1, $a2) = @_; | |
753 | return 0 unless @$a1 == @$a2; | |
754 | return 1 if $a1 eq $a2; | |
755 | ||
756 | my $ok = 1; | |
757 | for (0..$#{$a1}) { | |
758 | my($e1,$e2) = ($a1->[$_], $a2->[$_]); | |
759 | $ok = _deep_check($e1,$e2); | |
760 | last unless $ok; | |
761 | } | |
762 | return $ok; | |
763 | } | |
764 | ||
765 | sub _deep_check { | |
766 | my($e1, $e2) = @_; | |
767 | my $ok = 0; | |
768 | ||
d020a79a JH |
769 | my $eq; |
770 | { | |
771 | # Quiet unintialized value warnings when comparing undefs. | |
772 | local $^W = 0; | |
773 | ||
774 | if( $e1 eq $e2 ) { | |
775 | $ok = 1; | |
3f2ec160 JH |
776 | } |
777 | else { | |
d020a79a JH |
778 | if( UNIVERSAL::isa($e1, 'ARRAY') and |
779 | UNIVERSAL::isa($e2, 'ARRAY') ) | |
780 | { | |
781 | $ok = eq_array($e1, $e2); | |
782 | } | |
783 | elsif( UNIVERSAL::isa($e1, 'HASH') and | |
784 | UNIVERSAL::isa($e2, 'HASH') ) | |
785 | { | |
786 | $ok = eq_hash($e1, $e2); | |
787 | } | |
788 | else { | |
789 | $ok = 0; | |
790 | } | |
3f2ec160 JH |
791 | } |
792 | } | |
d020a79a | 793 | |
3f2ec160 JH |
794 | return $ok; |
795 | } | |
796 | ||
797 | ||
798 | =item B<eq_hash> | |
799 | ||
800 | eq_hash(\%this, \%that); | |
801 | ||
802 | Determines if the two hashes contain the same keys and values. This | |
803 | is a deep check. | |
804 | ||
805 | =cut | |
806 | ||
807 | sub eq_hash { | |
808 | my($a1, $a2) = @_; | |
809 | return 0 unless keys %$a1 == keys %$a2; | |
810 | return 1 if $a1 eq $a2; | |
811 | ||
812 | my $ok = 1; | |
813 | foreach my $k (keys %$a1) { | |
814 | my($e1, $e2) = ($a1->{$k}, $a2->{$k}); | |
815 | $ok = _deep_check($e1, $e2); | |
816 | last unless $ok; | |
817 | } | |
818 | ||
819 | return $ok; | |
820 | } | |
821 | ||
822 | =item B<eq_set> | |
823 | ||
824 | eq_set(\@this, \@that); | |
825 | ||
826 | Similar to eq_array(), except the order of the elements is B<not> | |
827 | important. This is a deep check, but the irrelevancy of order only | |
828 | applies to the top level. | |
829 | ||
830 | =cut | |
831 | ||
832 | # We must make sure that references are treated neutrally. It really | |
833 | # doesn't matter how we sort them, as long as both arrays are sorted | |
834 | # with the same algorithm. | |
d020a79a | 835 | sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b } |
3f2ec160 JH |
836 | |
837 | sub eq_set { | |
838 | my($a1, $a2) = @_; | |
839 | return 0 unless @$a1 == @$a2; | |
840 | ||
841 | # There's faster ways to do this, but this is easiest. | |
842 | return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] ); | |
843 | } | |
844 | ||
845 | ||
846 | =back | |
847 | ||
d020a79a JH |
848 | =head1 NOTES |
849 | ||
850 | Test::More is B<explicitly> tested all the way back to perl 5.004. | |
851 | ||
3f2ec160 JH |
852 | =head1 BUGS and CAVEATS |
853 | ||
d020a79a JH |
854 | =over 4 |
855 | ||
856 | =item Making your own ok() | |
857 | ||
858 | This will not do what you mean: | |
859 | ||
860 | sub my_ok { | |
861 | ok( @_ ); | |
862 | } | |
863 | ||
864 | my_ok( 2 + 2 == 5, 'Basic addition' ); | |
865 | ||
866 | since ok() takes it's arguments as scalars, it will see the length of | |
867 | @_ (2) and always pass the test. You want to do this instead: | |
3f2ec160 | 868 | |
d020a79a JH |
869 | sub my_ok { |
870 | ok( $_[0], $_[1] ); | |
871 | } | |
872 | ||
873 | The other functions act similiarly. | |
874 | ||
875 | =item The eq_* family have some caveats. | |
876 | ||
877 | =item Test::Harness upgrades | |
3f2ec160 | 878 | |
d020a79a JH |
879 | no_plan and todo depend on new Test::Harness features and fixes. If |
880 | you're going to distribute tests that use no_plan your end-users will | |
881 | have to upgrade Test::Harness to the latest one on CPAN. | |
882 | ||
883 | If you simply depend on Test::More, it's own dependencies will cause a | |
884 | Test::Harness upgrade. | |
885 | ||
886 | =back | |
3f2ec160 JH |
887 | |
888 | =head1 AUTHOR | |
889 | ||
d020a79a | 890 | Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration from |
3f2ec160 JH |
891 | Joshua Pritikin's Test module and lots of discussion with Barrie |
892 | Slaymaker and the perl-qa gang. | |
893 | ||
894 | ||
895 | =head1 HISTORY | |
896 | ||
897 | This is a case of convergent evolution with Joshua Pritikin's Test | |
d020a79a | 898 | module. I was largely unware of its existence when I'd first |
3f2ec160 JH |
899 | written my own ok() routines. This module exists because I can't |
900 | figure out how to easily wedge test names into Test's interface (along | |
901 | with a few other problems). | |
902 | ||
903 | The goal here is to have a testing utility that's simple to learn, | |
904 | quick to use and difficult to trip yourself up with while still | |
905 | providing more flexibility than the existing Test.pm. As such, the | |
906 | names of the most common routines are kept tiny, special cases and | |
907 | magic side-effects are kept to a minimum. WYSIWYG. | |
908 | ||
909 | ||
910 | =head1 SEE ALSO | |
911 | ||
912 | L<Test::Simple> if all this confuses you and you just want to write | |
913 | some tests. You can upgrade to Test::More later (its forward | |
914 | compatible). | |
915 | ||
916 | L<Test> for a similar testing module. | |
917 | ||
918 | L<Test::Harness> for details on how your test results are interpreted | |
919 | by Perl. | |
920 | ||
921 | L<Test::Unit> describes a very featureful unit testing interface. | |
922 | ||
923 | L<Pod::Tests> shows the idea of embedded testing. | |
924 | ||
925 | L<SelfTest> is another approach to embedded testing. | |
926 | ||
927 | =cut | |
928 | ||
929 | 1; |