Commit | Line | Data |
3f2ec160 |
1 | package Test::More; |
2 | |
d020a79a |
3 | use 5.004; |
3f2ec160 |
4 | |
d020a79a |
5 | use strict; |
6 | use Carp; |
7 | use Test::Utils; |
3f2ec160 |
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 |
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 |
24 | skip |
25 | $TODO |
26 | plan |
27 | can_ok isa_ok |
3f2ec160 |
28 | ); |
29 | |
30 | |
31 | sub import { |
32 | my($class, $plan, @args) = @_; |
33 | |
d020a79a |
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 |
47 | } |
48 | else { |
d020a79a |
49 | Test::Simple->import; |
3f2ec160 |
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 |
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 |
88 | SKIP: { |
89 | skip $why, $how_many unless $have_some_feature; |
90 | |
3f2ec160 |
91 | ok( foo(), $test_name ); |
92 | is( foo(42), 23, $test_name ); |
d020a79a |
93 | }; |
94 | |
95 | TODO: { |
96 | local $TODO = $why; |
3f2ec160 |
97 | |
3f2ec160 |
98 | ok( foo(), $test_name ); |
99 | is( foo(42), 23, $test_name ); |
d020a79a |
100 | }; |
101 | |
102 | can_ok($module, @methods); |
103 | isa_ok($object, $class); |
3f2ec160 |
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 |
116 | # UNIMPLEMENTED!!! |
117 | BAIL_OUT($why); |
118 | |
3f2ec160 |
119 | |
120 | =head1 DESCRIPTION |
121 | |
122 | If you're just getting started writing tests, have a look at |
d020a79a |
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 |
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 |
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 |
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 |
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 |
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 |
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 |
279 | For those grammatical pedants out there, there's an C<isn't()> |
280 | function which is an alias of isnt(). |
3f2ec160 |
281 | |
282 | =cut |
283 | |
284 | sub is ($$;$) { |
285 | my($this, $that, $name) = @_; |
286 | |
d020a79a |
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 |
294 | |
295 | unless( $ok ) { |
d020a79a |
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 |
301 | DIAGNOSTIC |
302 | |
303 | } |
304 | |
305 | return $ok; |
306 | } |
307 | |
308 | sub isnt ($$;$) { |
309 | my($this, $that, $name) = @_; |
310 | |
d020a79a |
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 |
319 | |
320 | unless( $ok ) { |
d020a79a |
321 | $that = defined $that ? "'$that'" : 'undef'; |
322 | |
323 | my_print *TESTERR, sprintf <<DIAGNOSTIC, $that; |
324 | # it should not be %s |
3f2ec160 |
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 |
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 |
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 |
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 |
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 |
394 | $this = defined $this ? "'$this'" : 'undef'; |
395 | my_print *TESTERR, sprintf <<DIAGNOSTIC, $this; |
396 | # %s |
3f2ec160 |
397 | # doesn't match '$regex' |
398 | DIAGNOSTIC |
399 | |
400 | } |
401 | |
402 | return $ok; |
403 | } |
404 | |
d020a79a |
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 |
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 |
513 | my($name) = @_; |
514 | return @_ == 1 ? ok(1, $name) |
515 | : ok(1); |
516 | } |
517 | |
d020a79a |
518 | sub fail (;$) { |
3f2ec160 |
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 |
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 |
552 | |
553 | =cut |
554 | |
d020a79a |
555 | sub use_ok ($;@) { |
556 | my($module, @imports) = @_; |
557 | @imports = () unless @imports; |
3f2ec160 |
558 | |
559 | my $pack = caller; |
560 | |
561 | eval <<USE; |
562 | package $pack; |
563 | require $module; |
d020a79a |
564 | $module->import(\@imports); |
3f2ec160 |
565 | USE |
566 | |
567 | my $ok = ok( !$@, "use $module;" ); |
568 | |
569 | unless( $ok ) { |
0cd946aa |
570 | chomp $@; |
d020a79a |
571 | my_print *TESTERR, <<DIAGNOSTIC; |
3f2ec160 |
572 | # Tried to use '$module'. |
573 | # Error: $@ |
574 | DIAGNOSTIC |
575 | |
576 | } |
577 | |
578 | return $ok; |
579 | } |
580 | |
d020a79a |
581 | =item B<require_ok> |
582 | |
583 | require_ok($module); |
584 | |
585 | Like use_ok(), except it requires the $module. |
586 | |
587 | =cut |
3f2ec160 |
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 |
604 | # Tried to require '$module'. |
605 | # Error: $@ |
606 | DIAGNOSTIC |
607 | |
608 | } |
609 | |
610 | return $ok; |
611 | } |
612 | |
d020a79a |
613 | =back |
3f2ec160 |
614 | |
615 | =head2 Conditional tests |
616 | |
d020a79a |
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 |
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 |
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 |
625 | but will work in the future (a todo test). |
626 | |
d020a79a |
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 |
632 | |
633 | =over 4 |
634 | |
d020a79a |
635 | =item B<SKIP: BLOCK> |
636 | |
637 | SKIP: { |
638 | skip $why, $how_many if $condition; |
3f2ec160 |
639 | |
d020a79a |
640 | ...normal testing code goes here... |
641 | } |
3f2ec160 |
642 | |
d020a79a |
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 |
647 | SKIP: { |
648 | skip "Pigs don't fly here", 2 unless Pigs->can('fly'); |
3f2ec160 |
649 | |
d020a79a |
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 |
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 |
670 | |
671 | =cut |
672 | |
d020a79a |
673 | #'# |
1af51bd3 |
674 | sub skip { |
d020a79a |
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 |
689 | } |
690 | |
3f2ec160 |
691 | |
d020a79a |
692 | =item B<TODO: BLOCK> |
3f2ec160 |
693 | |
d020a79a |
694 | TODO: { |
695 | local $TODO = $why; |
3f2ec160 |
696 | |
d020a79a |
697 | ...normal testing code goes here... |
698 | } |
3f2ec160 |
699 | |
d020a79a |
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 |
703 | TODO: { |
704 | local $TODO = "URI::Geller not finished"; |
3f2ec160 |
705 | |
d020a79a |
706 | my $card = "Eight of clubs"; |
707 | is( URI::Geller->your_card, $card, 'Is THIS your card?' ); |
3f2ec160 |
708 | |
d020a79a |
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 |
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 |
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 |
776 | } |
777 | else { |
d020a79a |
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 |
791 | } |
792 | } |
d020a79a |
793 | |
3f2ec160 |
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 |
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 |
848 | =head1 NOTES |
849 | |
850 | Test::More is B<explicitly> tested all the way back to perl 5.004. |
851 | |
3f2ec160 |
852 | =head1 BUGS and CAVEATS |
853 | |
d020a79a |
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 |
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 |
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 |
887 | |
888 | =head1 AUTHOR |
889 | |
d020a79a |
890 | Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration from |
3f2ec160 |
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 |
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; |