Commit | Line | Data |
3f2ec160 |
1 | package Test::More; |
2 | |
3 | use strict; |
4 | |
5 | |
6 | # Special print function to guard against $\ and -l munging. |
7 | sub _print (*@) { |
8 | my($fh, @args) = @_; |
9 | |
10 | local $\; |
11 | print $fh @args; |
12 | } |
13 | |
14 | sub print { die "DON'T USE PRINT! Use _print instead" } |
15 | |
16 | |
17 | BEGIN { |
18 | require Test::Simple; |
19 | *TESTOUT = \*Test::Simple::TESTOUT; |
20 | *TESTERR = \*Test::Simple::TESTERR; |
21 | } |
22 | |
23 | require Exporter; |
24 | use vars qw($VERSION @ISA @EXPORT); |
1af51bd3 |
25 | $VERSION = '0.07'; |
3f2ec160 |
26 | @ISA = qw(Exporter); |
27 | @EXPORT = qw(ok use_ok require_ok |
28 | is isnt like |
29 | skip todo |
30 | pass fail |
31 | eq_array eq_hash eq_set |
32 | ); |
33 | |
34 | |
35 | sub import { |
36 | my($class, $plan, @args) = @_; |
37 | |
38 | if( $plan eq 'skip_all' ) { |
39 | $Test::Simple::Skip_All = 1; |
40 | _print *TESTOUT, "1..0\n"; |
41 | exit(0); |
42 | } |
43 | else { |
44 | Test::Simple->import($plan => @args); |
45 | } |
46 | |
47 | __PACKAGE__->_export_to_level(1, __PACKAGE__); |
48 | } |
49 | |
50 | # 5.004's Exporter doesn't have export_to_level. |
51 | sub _export_to_level |
52 | { |
53 | my $pkg = shift; |
54 | my $level = shift; |
55 | (undef) = shift; # XXX redundant arg |
56 | my $callpkg = caller($level); |
57 | $pkg->export($callpkg, @_); |
58 | } |
59 | |
60 | |
61 | =head1 NAME |
62 | |
63 | Test::More - yet another framework for writing test scripts |
64 | |
65 | =head1 SYNOPSIS |
66 | |
67 | use Test::More tests => $Num_Tests; |
68 | # or |
69 | use Test::More qw(no_plan); |
70 | # or |
71 | use Test::More qw(skip_all); |
72 | |
73 | BEGIN { use_ok( 'Some::Module' ); } |
74 | require_ok( 'Some::Module' ); |
75 | |
76 | # Various ways to say "ok" |
77 | ok($this eq $that, $test_name); |
78 | |
79 | is ($this, $that, $test_name); |
80 | isnt($this, $that, $test_name); |
81 | like($this, qr/that/, $test_name); |
82 | |
83 | skip { # UNIMPLEMENTED!!! |
84 | ok( foo(), $test_name ); |
85 | is( foo(42), 23, $test_name ); |
86 | } $how_many, $why; |
87 | |
88 | todo { # UNIMPLEMENTED!!! |
89 | ok( foo(), $test_name ); |
90 | is( foo(42), 23, $test_name ); |
91 | } $how_many, $why; |
92 | |
93 | pass($test_name); |
94 | fail($test_name); |
95 | |
96 | # Utility comparison functions. |
97 | eq_array(\@this, \@that); |
98 | eq_hash(\%this, \%that); |
99 | eq_set(\@this, \@that); |
100 | |
101 | # UNIMPLEMENTED!!! |
102 | my @status = Test::More::status; |
103 | |
104 | |
105 | =head1 DESCRIPTION |
106 | |
107 | If you're just getting started writing tests, have a look at |
108 | Test::Simple first. |
109 | |
110 | This module provides a very wide range of testing utilities. Various |
111 | ways to say "ok", facilities to skip tests, test future features |
112 | and compare complicated data structures. |
113 | |
114 | |
115 | =head2 I love it when a plan comes together |
116 | |
117 | Before anything else, you need a testing plan. This basically declares |
118 | how many tests your script is going to run to protect against premature |
119 | failure. |
120 | |
121 | The prefered way to do this is to declare a plan when you C<use Test::More>. |
122 | |
123 | use Test::More tests => $Num_Tests; |
124 | |
125 | There are rare cases when you will not know beforehand how many tests |
126 | your script is going to run. In this case, you can declare that you |
127 | have no plan. (Try to avoid using this as it weakens your test.) |
128 | |
129 | use Test::More qw(no_plan); |
130 | |
131 | In some cases, you'll want to completely skip an entire testing script. |
132 | |
133 | use Test::More qw(skip_all); |
134 | |
135 | Your script will declare a skip and exit immediately with a zero |
136 | (success). L<Test::Harness> for details. |
137 | |
138 | |
139 | =head2 Test names |
140 | |
141 | By convention, each test is assigned a number in order. This is |
142 | largely done automatically for you. However, its often very useful to |
143 | assign a name to each test. Which would you rather see: |
144 | |
145 | ok 4 |
146 | not ok 5 |
147 | ok 6 |
148 | |
149 | or |
150 | |
151 | ok 4 - basic multi-variable |
152 | not ok 5 - simple exponential |
153 | ok 6 - force == mass * acceleration |
154 | |
155 | The later gives you some idea of what failed. It also makes it easier |
156 | to find the test in your script, simply search for "simple |
157 | exponential". |
158 | |
159 | All test functions take a name argument. Its optional, but highly |
160 | suggested that you use it. |
161 | |
162 | |
163 | =head2 I'm ok, you're not ok. |
164 | |
165 | The basic purpose of this module is to print out either "ok #" or "not |
166 | ok #" depending on if a given test succeeded or failed. Everything |
167 | else is just gravy. |
168 | |
169 | All of the following print "ok" or "not ok" depending on if the test |
170 | succeeded or failed. They all also return true or false, |
171 | respectively. |
172 | |
173 | =over 4 |
174 | |
175 | =item B<ok> |
176 | |
177 | ok($this eq $that, $test_name); |
178 | |
179 | This simply evaluates any expression (C<$this eq $that> is just a |
180 | simple example) and uses that to determine if the test succeeded or |
181 | failed. A true expression passes, a false one fails. Very simple. |
182 | |
183 | For example: |
184 | |
185 | ok( $exp{9} == 81, 'simple exponential' ); |
186 | ok( Film->can('db_Main'), 'set_db()' ); |
187 | ok( $p->tests == 4, 'saw tests' ); |
188 | ok( !grep !defined $_, @items, 'items populated' ); |
189 | |
190 | (Mnemonic: "This is ok.") |
191 | |
192 | $test_name is a very short description of the test that will be printed |
193 | out. It makes it very easy to find a test in your script when it fails |
194 | and gives others an idea of your intentions. $test_name is optional, |
195 | but we B<very> strongly encourage its use. |
196 | |
197 | Should an ok() fail, it will produce some diagnostics: |
198 | |
199 | not ok 18 - sufficient mucus |
200 | # Failed test 18 (foo.t at line 42) |
201 | |
202 | This is actually Test::Simple's ok() routine. |
203 | |
204 | =cut |
205 | |
206 | # We get ok() from Test::Simple's import(). |
207 | |
208 | =item B<is> |
209 | |
210 | =item B<isnt> |
211 | |
212 | is ( $this, $that, $test_name ); |
213 | isnt( $this, $that, $test_name ); |
214 | |
215 | Similar to ok(), is() and isnt() compare their two arguments with |
216 | C<eq> and C<ne> respectively and use the result of that to determine |
217 | if the test succeeded or failed. So these: |
218 | |
219 | # Is the ultimate answer 42? |
220 | is( ultimate_answer(), 42, "Meaning of Life" ); |
221 | |
222 | # $foo isn't empty |
223 | isnt( $foo, '', "Got some foo" ); |
224 | |
225 | are similar to these: |
226 | |
227 | ok( ultimate_answer() eq 42, "Meaning of Life" ); |
228 | ok( $foo ne '', "Got some foo" ); |
229 | |
230 | (Mnemonic: "This is that." "This isn't that.") |
231 | |
232 | So why use these? They produce better diagnostics on failure. ok() |
233 | cannot know what you are testing for (beyond the name), but is() and |
234 | isnt() know what the test was and why it failed. For example this |
235 | test: |
236 | |
237 | my $foo = 'waffle'; my $bar = 'yarblokos'; |
238 | is( $foo, $bar, 'Is foo the same as bar?' ); |
239 | |
240 | Will produce something like this: |
241 | |
242 | not ok 17 - Is foo the same as bar? |
243 | # Failed test 1 (foo.t at line 139) |
244 | # got: 'waffle' |
245 | # expected: 'yarblokos' |
246 | |
247 | So you can figure out what went wrong without rerunning the test. |
248 | |
249 | You are encouraged to use is() and isnt() over ok() where possible, |
250 | however do not be tempted to use them to find out if something is |
251 | true or false! |
252 | |
253 | # XXX BAD! $pope->isa('Catholic') eq 1 |
254 | is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' ); |
255 | |
256 | This does not check if C<$pope->isa('Catholic')> is true, it checks if |
257 | it returns 1. Very different. Similar caveats exist for false and 0. |
258 | In these cases, use ok(). |
259 | |
260 | ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' ); |
261 | |
262 | For those grammatical pedants out there, there's an isn't() function |
263 | which is an alias of isnt(). |
264 | |
265 | =cut |
266 | |
267 | sub is ($$;$) { |
268 | my($this, $that, $name) = @_; |
269 | |
270 | my $ok = @_ == 3 ? ok($this eq $that, $name) |
271 | : ok($this eq $that); |
272 | |
273 | unless( $ok ) { |
274 | _print *TESTERR, <<DIAGNOSTIC; |
275 | # got: '$this' |
276 | # expected: '$that' |
277 | DIAGNOSTIC |
278 | |
279 | } |
280 | |
281 | return $ok; |
282 | } |
283 | |
284 | sub isnt ($$;$) { |
285 | my($this, $that, $name) = @_; |
286 | |
287 | my $ok = @_ == 3 ? ok($this ne $that, $name) |
288 | : ok($this ne $that); |
289 | |
290 | unless( $ok ) { |
291 | _print *TESTERR, <<DIAGNOSTIC; |
292 | # it should not be '$that' |
293 | # but it is. |
294 | DIAGNOSTIC |
295 | |
296 | } |
297 | |
298 | return $ok; |
299 | } |
300 | |
301 | *isn't = \&isnt; |
302 | |
303 | |
304 | =item B<like> |
305 | |
306 | like( $this, qr/that/, $test_name ); |
307 | |
308 | Similar to ok(), like() matches $this against the regex C<qr/that/>. |
309 | |
310 | So this: |
311 | |
312 | like($this, qr/that/, 'this is like that'); |
313 | |
314 | is similar to: |
315 | |
316 | ok( $this =~ /that/, 'this is like that'); |
317 | |
318 | (Mnemonic "This is like that".) |
319 | |
320 | The second argument is a regular expression. It may be given as a |
321 | regex reference (ie. qr//) or (for better compatibility with older |
322 | perls) as a string that looks like a regex (alternative delimiters are |
323 | currently not supported): |
324 | |
325 | like( $this, '/that/', 'this is like that' ); |
326 | |
327 | Regex options may be placed on the end (C<'/that/i'>). |
328 | |
329 | Its advantages over ok() are similar to that of is() and isnt(). Better |
330 | diagnostics on failure. |
331 | |
332 | =cut |
333 | |
334 | sub like ($$;$) { |
335 | my($this, $regex, $name) = @_; |
336 | |
337 | my $ok = 0; |
338 | if( ref $regex eq 'Regexp' ) { |
339 | $ok = @_ == 3 ? ok( $this =~ $regex ? 1 : 0, $name ) |
340 | : ok( $this =~ $regex ? 1 : 0 ); |
341 | } |
342 | # Check if it looks like '/foo/i' |
343 | elsif( my($re, $opts) = $regex =~ m{^ /(.*)/ (\w*) $ }sx ) { |
344 | $ok = @_ == 3 ? ok( $this =~ /(?$opts)$re/ ? 1 : 0, $name ) |
345 | : ok( $this =~ /(?$opts)$re/ ? 1 : 0 ); |
346 | } |
347 | else { |
348 | # Can't use fail() here, the call stack will be fucked. |
349 | my $ok = @_ == 3 ? ok(0, $name ) |
350 | : ok(0); |
351 | |
352 | _print *TESTERR, <<ERR; |
353 | # '$regex' doesn't look much like a regex to me. Failing the test. |
354 | ERR |
355 | |
356 | return $ok; |
357 | } |
358 | |
359 | unless( $ok ) { |
360 | _print *TESTERR, <<DIAGNOSTIC; |
361 | # '$this' |
362 | # doesn't match '$regex' |
363 | DIAGNOSTIC |
364 | |
365 | } |
366 | |
367 | return $ok; |
368 | } |
369 | |
370 | =item B<pass> |
371 | |
372 | =item B<fail> |
373 | |
374 | pass($test_name); |
375 | fail($test_name); |
376 | |
377 | Sometimes you just want to say that the tests have passed. Usually |
378 | the case is you've got some complicated condition that is difficult to |
379 | wedge into an ok(). In this case, you can simply use pass() (to |
380 | declare the test ok) or fail (for not ok). They are synonyms for |
381 | ok(1) and ok(0). |
382 | |
383 | Use these very, very, very sparingly. |
384 | |
385 | =cut |
386 | |
387 | sub pass ($) { |
388 | my($name) = @_; |
389 | return @_ == 1 ? ok(1, $name) |
390 | : ok(1); |
391 | } |
392 | |
393 | sub fail ($) { |
394 | my($name) = @_; |
395 | return @_ == 1 ? ok(0, $name) |
396 | : ok(0); |
397 | } |
398 | |
399 | =back |
400 | |
401 | =head2 Module tests |
402 | |
403 | You usually want to test if the module you're testing loads ok, rather |
404 | than just vomiting if its load fails. For such purposes we have |
405 | C<use_ok> and C<require_ok>. |
406 | |
407 | =over 4 |
408 | |
409 | =item B<use_ok> |
410 | |
411 | =item B<require_ok> |
412 | |
413 | BEGIN { use_ok($module); } |
414 | require_ok($module); |
415 | |
416 | These simply use or require the given $module and test to make sure |
417 | the load happened ok. Its recommended that you run use_ok() inside a |
418 | BEGIN block so its functions are exported at compile-time and |
419 | prototypes are properly honored. |
420 | |
421 | =cut |
422 | |
423 | sub use_ok ($) { |
424 | my($module) = shift; |
425 | |
426 | my $pack = caller; |
427 | |
428 | eval <<USE; |
429 | package $pack; |
430 | require $module; |
431 | $module->import; |
432 | USE |
433 | |
434 | my $ok = ok( !$@, "use $module;" ); |
435 | |
436 | unless( $ok ) { |
437 | _print *TESTERR, <<DIAGNOSTIC; |
438 | # Tried to use '$module'. |
439 | # Error: $@ |
440 | DIAGNOSTIC |
441 | |
442 | } |
443 | |
444 | return $ok; |
445 | } |
446 | |
447 | |
448 | sub require_ok ($) { |
449 | my($module) = shift; |
450 | |
451 | my $pack = caller; |
452 | |
453 | eval <<REQUIRE; |
454 | package $pack; |
455 | require $module; |
456 | REQUIRE |
457 | |
458 | my $ok = ok( !$@, "require $module;" ); |
459 | |
460 | unless( $ok ) { |
461 | _print *TESTERR, <<DIAGNOSTIC; |
462 | # Tried to require '$module'. |
463 | # Error: $@ |
464 | DIAGNOSTIC |
465 | |
466 | } |
467 | |
468 | return $ok; |
469 | } |
470 | |
471 | |
472 | =head2 Conditional tests |
473 | |
474 | Sometimes running a test under certain conditions will cause the |
475 | test script to die. A certain function or method isn't implemented |
476 | (such as fork() on MacOS), some resource isn't available (like a |
477 | net connection) or a module isn't available. In these cases its |
478 | necessary to skip test, or declare that they are supposed to fail |
479 | but will work in the future (a todo test). |
480 | |
481 | For more details on skip and todo tests, L<Test::Harness>. |
482 | |
483 | =over 4 |
484 | |
485 | =item B<skip> * UNIMPLEMENTED * |
486 | |
487 | skip BLOCK $how_many, $why, $if; |
488 | |
489 | B<NOTE> Should that be $if or $unless? |
490 | |
491 | This declares a block of tests to skip, why and under what conditions |
492 | to skip them. An example is the easiest way to illustrate: |
493 | |
494 | skip { |
495 | ok( head("http://www.foo.com"), "www.foo.com is alive" ); |
496 | ok( head("http://www.foo.com/bar"), " and has bar" ); |
497 | } 2, "LWP::Simple not installed", |
498 | !eval { require LWP::Simple; LWP::Simple->import; 1 }; |
499 | |
500 | The $if condition is optional, but $why is not. |
501 | |
502 | =cut |
503 | |
1af51bd3 |
504 | sub skip { |
505 | die "skip() is UNIMPLEMENTED!"; |
3f2ec160 |
506 | } |
507 | |
508 | =item B<todo> * UNIMPLEMENTED * |
509 | |
510 | todo BLOCK $how_many, $why; |
511 | todo BLOCK $how_many, $why, $until; |
512 | |
513 | Declares a block of tests you expect to fail and why. Perhaps its |
514 | because you haven't fixed a bug: |
515 | |
516 | todo { is( $Gravitational_Constant, 0 ) } 1, |
517 | "Still tinkering with physics --God"; |
518 | |
519 | If you have a set of functionality yet to implement, you can make the |
520 | whole suite dependent on that new feature. |
521 | |
522 | todo { |
523 | $pig->takeoff; |
524 | ok( $pig->altitude > 0 ); |
525 | ok( $pig->mach > 2 ); |
526 | ok( $pig->serve_peanuts ); |
527 | } 1, "Pigs are still safely grounded", |
528 | Pigs->can('fly'); |
529 | |
530 | =cut |
531 | |
1af51bd3 |
532 | sub todo { |
533 | die "todo() is UNIMPLEMENTED!"; |
3f2ec160 |
534 | } |
535 | |
536 | =head2 Comparision functions |
537 | |
538 | Not everything is a simple eq check or regex. There are times you |
539 | need to see if two arrays are equivalent, for instance. For these |
540 | instances, Test::More provides a handful of useful functions. |
541 | |
542 | B<NOTE> These are NOT well-tested on circular references. Nor am I |
543 | quite sure what will happen with filehandles. |
544 | |
545 | =over 4 |
546 | |
547 | =item B<eq_array> |
548 | |
549 | eq_array(\@this, \@that); |
550 | |
551 | Checks if two arrays are equivalent. This is a deep check, so |
552 | multi-level structures are handled correctly. |
553 | |
554 | =cut |
555 | |
556 | #'# |
557 | sub eq_array { |
558 | my($a1, $a2) = @_; |
559 | return 0 unless @$a1 == @$a2; |
560 | return 1 if $a1 eq $a2; |
561 | |
562 | my $ok = 1; |
563 | for (0..$#{$a1}) { |
564 | my($e1,$e2) = ($a1->[$_], $a2->[$_]); |
565 | $ok = _deep_check($e1,$e2); |
566 | last unless $ok; |
567 | } |
568 | return $ok; |
569 | } |
570 | |
571 | sub _deep_check { |
572 | my($e1, $e2) = @_; |
573 | my $ok = 0; |
574 | |
575 | if($e1 eq $e2) { |
576 | $ok = 1; |
577 | } |
578 | else { |
579 | if( UNIVERSAL::isa($e1, 'ARRAY') and |
580 | UNIVERSAL::isa($e2, 'ARRAY') ) |
581 | { |
582 | $ok = eq_array($e1, $e2); |
583 | } |
584 | elsif( UNIVERSAL::isa($e1, 'HASH') and |
585 | UNIVERSAL::isa($e2, 'HASH') ) |
586 | { |
587 | $ok = eq_hash($e1, $e2); |
588 | } |
589 | else { |
590 | $ok = 0; |
591 | } |
592 | } |
593 | return $ok; |
594 | } |
595 | |
596 | |
597 | =item B<eq_hash> |
598 | |
599 | eq_hash(\%this, \%that); |
600 | |
601 | Determines if the two hashes contain the same keys and values. This |
602 | is a deep check. |
603 | |
604 | =cut |
605 | |
606 | sub eq_hash { |
607 | my($a1, $a2) = @_; |
608 | return 0 unless keys %$a1 == keys %$a2; |
609 | return 1 if $a1 eq $a2; |
610 | |
611 | my $ok = 1; |
612 | foreach my $k (keys %$a1) { |
613 | my($e1, $e2) = ($a1->{$k}, $a2->{$k}); |
614 | $ok = _deep_check($e1, $e2); |
615 | last unless $ok; |
616 | } |
617 | |
618 | return $ok; |
619 | } |
620 | |
621 | =item B<eq_set> |
622 | |
623 | eq_set(\@this, \@that); |
624 | |
625 | Similar to eq_array(), except the order of the elements is B<not> |
626 | important. This is a deep check, but the irrelevancy of order only |
627 | applies to the top level. |
628 | |
629 | =cut |
630 | |
631 | # We must make sure that references are treated neutrally. It really |
632 | # doesn't matter how we sort them, as long as both arrays are sorted |
633 | # with the same algorithm. |
634 | sub _bogus_sort { ref $a ? 0 : $a cmp $b } |
635 | |
636 | sub eq_set { |
637 | my($a1, $a2) = @_; |
638 | return 0 unless @$a1 == @$a2; |
639 | |
640 | # There's faster ways to do this, but this is easiest. |
641 | return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] ); |
642 | } |
643 | |
644 | |
645 | =back |
646 | |
647 | =head1 BUGS and CAVEATS |
648 | |
649 | The eq_* family have some caveats. |
650 | |
651 | todo() and skip() are unimplemented. |
652 | |
653 | The no_plan feature depends on new Test::Harness feature. If you're going |
654 | to distribute tests that use no_plan your end-users will have to upgrade |
655 | Test::Harness to the latest one on CPAN. |
656 | |
657 | =head1 AUTHOR |
658 | |
659 | Michael G Schwern <schwern@pobox.com> with much inspiration from |
660 | Joshua Pritikin's Test module and lots of discussion with Barrie |
661 | Slaymaker and the perl-qa gang. |
662 | |
663 | |
664 | =head1 HISTORY |
665 | |
666 | This is a case of convergent evolution with Joshua Pritikin's Test |
667 | module. I was actually largely unware of its existance when I'd first |
668 | written my own ok() routines. This module exists because I can't |
669 | figure out how to easily wedge test names into Test's interface (along |
670 | with a few other problems). |
671 | |
672 | The goal here is to have a testing utility that's simple to learn, |
673 | quick to use and difficult to trip yourself up with while still |
674 | providing more flexibility than the existing Test.pm. As such, the |
675 | names of the most common routines are kept tiny, special cases and |
676 | magic side-effects are kept to a minimum. WYSIWYG. |
677 | |
678 | |
679 | =head1 SEE ALSO |
680 | |
681 | L<Test::Simple> if all this confuses you and you just want to write |
682 | some tests. You can upgrade to Test::More later (its forward |
683 | compatible). |
684 | |
685 | L<Test> for a similar testing module. |
686 | |
687 | L<Test::Harness> for details on how your test results are interpreted |
688 | by Perl. |
689 | |
690 | L<Test::Unit> describes a very featureful unit testing interface. |
691 | |
692 | L<Pod::Tests> shows the idea of embedded testing. |
693 | |
694 | L<SelfTest> is another approach to embedded testing. |
695 | |
696 | =cut |
697 | |
698 | 1; |