This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Upgrade to Test::More 0.07.
[perl5.git] / lib / Test / More.pm
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);
25 $VERSION = '0.07';
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
504 sub skip {
505     die "skip() is UNIMPLEMENTED!";
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
532 sub todo {
533     die "todo() is UNIMPLEMENTED!";
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;