This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
Test::More
[perl5.git] / lib / Test / More.pm
CommitLineData
3f2ec160
JH
1package Test::More;
2
d020a79a 3use 5.004;
3f2ec160 4
d020a79a 5use strict;
33459055 6use Test::Builder;
3f2ec160 7
33459055
MS
8
9# Can't use Carp because it might cause use_ok() to accidentally succeed
10# even though the module being used forgot to use Carp. Yes, this
11# actually happened.
12sub _carp {
13 my($file, $line) = (caller(1))[1,2];
a9153838 14 warn @_, " at $file line $line\n";
3f2ec160
JH
15}
16
33459055
MS
17
18
3f2ec160 19require Exporter;
33459055 20use vars qw($VERSION @ISA @EXPORT %EXPORT_TAGS $TODO);
60ffb308 21$VERSION = '0.47';
3f2ec160
JH
22@ISA = qw(Exporter);
23@EXPORT = qw(ok use_ok require_ok
a9153838
MS
24 is isnt like unlike is_deeply
25 cmp_ok
26 skip todo todo_skip
3f2ec160 27 pass fail
de2dd90a 28 eq_array eq_hash eq_set
d020a79a
JH
29 $TODO
30 plan
31 can_ok isa_ok
a9153838 32 diag
3f2ec160
JH
33 );
34
33459055 35my $Test = Test::Builder->new;
3f2ec160 36
3f2ec160
JH
37
38# 5.004's Exporter doesn't have export_to_level.
39sub _export_to_level
40{
41 my $pkg = shift;
42 my $level = shift;
a9153838 43 (undef) = shift; # redundant arg
3f2ec160
JH
44 my $callpkg = caller($level);
45 $pkg->export($callpkg, @_);
46}
47
48
49=head1 NAME
50
51Test::More - yet another framework for writing test scripts
52
53=head1 SYNOPSIS
54
55 use Test::More tests => $Num_Tests;
56 # or
57 use Test::More qw(no_plan);
58 # or
d020a79a 59 use Test::More skip_all => $reason;
3f2ec160
JH
60
61 BEGIN { use_ok( 'Some::Module' ); }
62 require_ok( 'Some::Module' );
63
64 # Various ways to say "ok"
65 ok($this eq $that, $test_name);
66
67 is ($this, $that, $test_name);
68 isnt($this, $that, $test_name);
a9153838
MS
69
70 # Rather than print STDERR "# here's what went wrong\n"
71 diag("here's what went wrong");
72
73 like ($this, qr/that/, $test_name);
74 unlike($this, qr/that/, $test_name);
75
76 cmp_ok($this, '==', $that, $test_name);
3f2ec160 77
33459055
MS
78 is_deeply($complex_structure1, $complex_structure2, $test_name);
79
d020a79a
JH
80 SKIP: {
81 skip $why, $how_many unless $have_some_feature;
82
3f2ec160
JH
83 ok( foo(), $test_name );
84 is( foo(42), 23, $test_name );
d020a79a
JH
85 };
86
87 TODO: {
88 local $TODO = $why;
3f2ec160 89
3f2ec160
JH
90 ok( foo(), $test_name );
91 is( foo(42), 23, $test_name );
d020a79a
JH
92 };
93
94 can_ok($module, @methods);
95 isa_ok($object, $class);
3f2ec160
JH
96
97 pass($test_name);
98 fail($test_name);
99
100 # Utility comparison functions.
101 eq_array(\@this, \@that);
102 eq_hash(\%this, \%that);
103 eq_set(\@this, \@that);
104
105 # UNIMPLEMENTED!!!
106 my @status = Test::More::status;
107
d020a79a
JH
108 # UNIMPLEMENTED!!!
109 BAIL_OUT($why);
110
3f2ec160
JH
111
112=head1 DESCRIPTION
113
a9153838 114B<STOP!> If you're just getting started writing tests, have a look at
d020a79a
JH
115Test::Simple first. This is a drop in replacement for Test::Simple
116which you can switch to once you get the hang of basic testing.
3f2ec160 117
a9153838
MS
118The purpose of this module is to provide a wide range of testing
119utilities. Various ways to say "ok" with better diagnostics,
120facilities to skip tests, test future features and compare complicated
121data structures. While you can do almost anything with a simple
122C<ok()> function, it doesn't provide good diagnostic output.
3f2ec160
JH
123
124
125=head2 I love it when a plan comes together
126
127Before anything else, you need a testing plan. This basically declares
128how many tests your script is going to run to protect against premature
129failure.
130
4bd4e70a 131The preferred way to do this is to declare a plan when you C<use Test::More>.
3f2ec160
JH
132
133 use Test::More tests => $Num_Tests;
134
135There are rare cases when you will not know beforehand how many tests
136your script is going to run. In this case, you can declare that you
137have no plan. (Try to avoid using this as it weakens your test.)
138
139 use Test::More qw(no_plan);
140
141In some cases, you'll want to completely skip an entire testing script.
142
d020a79a 143 use Test::More skip_all => $skip_reason;
3f2ec160 144
d020a79a
JH
145Your script will declare a skip with the reason why you skipped and
146exit immediately with a zero (success). See L<Test::Harness> for
147details.
3f2ec160 148
33459055
MS
149If you want to control what functions Test::More will export, you
150have to use the 'import' option. For example, to import everything
151but 'fail', you'd do:
152
153 use Test::More tests => 23, import => ['!fail'];
154
155Alternatively, you can use the plan() function. Useful for when you
156have to calculate the number of tests.
157
158 use Test::More;
159 plan tests => keys %Stuff * 3;
160
161or for deciding between running the tests at all:
162
163 use Test::More;
164 if( $^O eq 'MacOS' ) {
4bd4e70a 165 plan skip_all => 'Test irrelevant on MacOS';
33459055
MS
166 }
167 else {
168 plan tests => 42;
169 }
170
171=cut
172
173sub plan {
174 my(@plan) = @_;
175
176 my $caller = caller;
177
178 $Test->exported_to($caller);
33459055
MS
179
180 my @imports = ();
181 foreach my $idx (0..$#plan) {
182 if( $plan[$idx] eq 'import' ) {
89c1e84a
MS
183 my($tag, $imports) = splice @plan, $idx, 2;
184 @imports = @$imports;
33459055
MS
185 last;
186 }
187 }
188
89c1e84a
MS
189 $Test->plan(@plan);
190
33459055
MS
191 __PACKAGE__->_export_to_level(1, __PACKAGE__, @imports);
192}
193
194sub import {
195 my($class) = shift;
196 goto &plan;
197}
198
3f2ec160
JH
199
200=head2 Test names
201
202By convention, each test is assigned a number in order. This is
6686786d 203largely done automatically for you. However, it's often very useful to
3f2ec160
JH
204assign a name to each test. Which would you rather see:
205
206 ok 4
207 not ok 5
208 ok 6
209
210or
211
212 ok 4 - basic multi-variable
213 not ok 5 - simple exponential
214 ok 6 - force == mass * acceleration
215
216The later gives you some idea of what failed. It also makes it easier
217to find the test in your script, simply search for "simple
218exponential".
219
6686786d 220All test functions take a name argument. It's optional, but highly
3f2ec160
JH
221suggested that you use it.
222
223
224=head2 I'm ok, you're not ok.
225
226The basic purpose of this module is to print out either "ok #" or "not
227ok #" depending on if a given test succeeded or failed. Everything
228else is just gravy.
229
230All of the following print "ok" or "not ok" depending on if the test
231succeeded or failed. They all also return true or false,
232respectively.
233
234=over 4
235
236=item B<ok>
237
238 ok($this eq $that, $test_name);
239
240This simply evaluates any expression (C<$this eq $that> is just a
241simple example) and uses that to determine if the test succeeded or
242failed. A true expression passes, a false one fails. Very simple.
243
244For example:
245
246 ok( $exp{9} == 81, 'simple exponential' );
247 ok( Film->can('db_Main'), 'set_db()' );
248 ok( $p->tests == 4, 'saw tests' );
249 ok( !grep !defined $_, @items, 'items populated' );
250
251(Mnemonic: "This is ok.")
252
253$test_name is a very short description of the test that will be printed
254out. It makes it very easy to find a test in your script when it fails
255and gives others an idea of your intentions. $test_name is optional,
256but we B<very> strongly encourage its use.
257
258Should an ok() fail, it will produce some diagnostics:
259
260 not ok 18 - sufficient mucus
261 # Failed test 18 (foo.t at line 42)
262
263This is actually Test::Simple's ok() routine.
264
265=cut
266
33459055
MS
267sub ok ($;$) {
268 my($test, $name) = @_;
269 $Test->ok($test, $name);
270}
3f2ec160
JH
271
272=item B<is>
273
274=item B<isnt>
275
276 is ( $this, $that, $test_name );
277 isnt( $this, $that, $test_name );
278
d020a79a
JH
279Similar to ok(), is() and isnt() compare their two arguments
280with C<eq> and C<ne> respectively and use the result of that to
281determine if the test succeeded or failed. So these:
3f2ec160
JH
282
283 # Is the ultimate answer 42?
284 is( ultimate_answer(), 42, "Meaning of Life" );
285
286 # $foo isn't empty
287 isnt( $foo, '', "Got some foo" );
288
289are similar to these:
290
291 ok( ultimate_answer() eq 42, "Meaning of Life" );
292 ok( $foo ne '', "Got some foo" );
293
294(Mnemonic: "This is that." "This isn't that.")
295
296So why use these? They produce better diagnostics on failure. ok()
297cannot know what you are testing for (beyond the name), but is() and
298isnt() know what the test was and why it failed. For example this
d020a79a 299test:
3f2ec160
JH
300
301 my $foo = 'waffle'; my $bar = 'yarblokos';
302 is( $foo, $bar, 'Is foo the same as bar?' );
303
304Will produce something like this:
305
306 not ok 17 - Is foo the same as bar?
60ffb308 307 # Failed test (foo.t at line 139)
3f2ec160
JH
308 # got: 'waffle'
309 # expected: 'yarblokos'
310
311So you can figure out what went wrong without rerunning the test.
312
313You are encouraged to use is() and isnt() over ok() where possible,
314however do not be tempted to use them to find out if something is
315true or false!
316
317 # XXX BAD! $pope->isa('Catholic') eq 1
318 is( $pope->isa('Catholic'), 1, 'Is the Pope Catholic?' );
319
320This does not check if C<$pope->isa('Catholic')> is true, it checks if
321it returns 1. Very different. Similar caveats exist for false and 0.
322In these cases, use ok().
323
324 ok( $pope->isa('Catholic') ), 'Is the Pope Catholic?' );
325
d020a79a
JH
326For those grammatical pedants out there, there's an C<isn't()>
327function which is an alias of isnt().
3f2ec160
JH
328
329=cut
330
331sub is ($$;$) {
33459055 332 $Test->is_eq(@_);
3f2ec160
JH
333}
334
335sub isnt ($$;$) {
a9153838 336 $Test->isnt_eq(@_);
3f2ec160
JH
337}
338
339*isn't = \&isnt;
340
341
342=item B<like>
343
344 like( $this, qr/that/, $test_name );
345
346Similar to ok(), like() matches $this against the regex C<qr/that/>.
347
348So this:
349
350 like($this, qr/that/, 'this is like that');
351
352is similar to:
353
354 ok( $this =~ /that/, 'this is like that');
355
356(Mnemonic "This is like that".)
357
358The second argument is a regular expression. It may be given as a
4bd4e70a 359regex reference (i.e. C<qr//>) or (for better compatibility with older
3f2ec160
JH
360perls) as a string that looks like a regex (alternative delimiters are
361currently not supported):
362
363 like( $this, '/that/', 'this is like that' );
364
365Regex options may be placed on the end (C<'/that/i'>).
366
367Its advantages over ok() are similar to that of is() and isnt(). Better
368diagnostics on failure.
369
370=cut
371
372sub like ($$;$) {
33459055 373 $Test->like(@_);
3f2ec160
JH
374}
375
a9153838
MS
376
377=item B<unlike>
378
379 unlike( $this, qr/that/, $test_name );
380
381Works exactly as like(), only it checks if $this B<does not> match the
382given pattern.
383
384=cut
385
386sub unlike {
387 $Test->unlike(@_);
388}
389
390
391=item B<cmp_ok>
392
393 cmp_ok( $this, $op, $that, $test_name );
394
395Halfway between ok() and is() lies cmp_ok(). This allows you to
396compare two arguments using any binary perl operator.
397
398 # ok( $this eq $that );
399 cmp_ok( $this, 'eq', $that, 'this eq that' );
400
401 # ok( $this == $that );
402 cmp_ok( $this, '==', $that, 'this == that' );
403
404 # ok( $this && $that );
405 cmp_ok( $this, '&&', $that, 'this || that' );
406 ...etc...
407
408Its advantage over ok() is when the test fails you'll know what $this
409and $that were:
410
411 not ok 1
412 # Failed test (foo.t at line 12)
413 # '23'
414 # &&
415 # undef
416
6686786d 417It's also useful in those cases where you are comparing numbers and
a9153838
MS
418is()'s use of C<eq> will interfere:
419
420 cmp_ok( $big_hairy_number, '==', $another_big_hairy_number );
421
422=cut
423
424sub cmp_ok($$$;$) {
425 $Test->cmp_ok(@_);
426}
427
428
d020a79a
JH
429=item B<can_ok>
430
431 can_ok($module, @methods);
432 can_ok($object, @methods);
433
434Checks to make sure the $module or $object can do these @methods
435(works with functions, too).
436
437 can_ok('Foo', qw(this that whatever));
438
439is almost exactly like saying:
440
441 ok( Foo->can('this') &&
442 Foo->can('that') &&
443 Foo->can('whatever')
444 );
445
446only without all the typing and with a better interface. Handy for
447quickly testing an interface.
448
a9153838
MS
449No matter how many @methods you check, a single can_ok() call counts
450as one test. If you desire otherwise, use:
451
452 foreach my $meth (@methods) {
453 can_ok('Foo', $meth);
454 }
455
d020a79a
JH
456=cut
457
458sub can_ok ($@) {
459 my($proto, @methods) = @_;
89c1e84a 460 my $class = ref $proto || $proto;
d020a79a 461
a9153838
MS
462 unless( @methods ) {
463 my $ok = $Test->ok( 0, "$class->can(...)" );
464 $Test->diag(' can_ok() called with no methods');
465 return $ok;
466 }
467
d020a79a
JH
468 my @nok = ();
469 foreach my $method (@methods) {
a9153838
MS
470 local($!, $@); # don't interfere with caller's $@
471 # eval sometimes resets $!
89c1e84a 472 eval { $proto->can($method) } || push @nok, $method;
d020a79a
JH
473 }
474
475 my $name;
6686786d 476 $name = @methods == 1 ? "$class->can('$methods[0]')"
d020a79a
JH
477 : "$class->can(...)";
478
33459055 479 my $ok = $Test->ok( !@nok, $name );
d020a79a 480
a9153838 481 $Test->diag(map " $class->can('$_') failed\n", @nok);
d020a79a 482
33459055 483 return $ok;
d020a79a
JH
484}
485
486=item B<isa_ok>
487
33459055 488 isa_ok($object, $class, $object_name);
a9153838 489 isa_ok($ref, $type, $ref_name);
d020a79a
JH
490
491Checks to see if the given $object->isa($class). Also checks to make
492sure the object was defined in the first place. Handy for this sort
493of thing:
494
495 my $obj = Some::Module->new;
496 isa_ok( $obj, 'Some::Module' );
497
498where you'd otherwise have to write
499
500 my $obj = Some::Module->new;
501 ok( defined $obj && $obj->isa('Some::Module') );
502
503to safeguard against your test script blowing up.
504
a9153838
MS
505It works on references, too:
506
507 isa_ok( $array_ref, 'ARRAY' );
508
33459055
MS
509The diagnostics of this test normally just refer to 'the object'. If
510you'd like them to be more specific, you can supply an $object_name
511(for example 'Test customer').
512
d020a79a
JH
513=cut
514
33459055
MS
515sub isa_ok ($$;$) {
516 my($object, $class, $obj_name) = @_;
d020a79a
JH
517
518 my $diag;
33459055
MS
519 $obj_name = 'The object' unless defined $obj_name;
520 my $name = "$obj_name isa $class";
d020a79a 521 if( !defined $object ) {
33459055 522 $diag = "$obj_name isn't defined";
d020a79a
JH
523 }
524 elsif( !ref $object ) {
33459055 525 $diag = "$obj_name isn't a reference";
d020a79a 526 }
a9153838
MS
527 else {
528 # We can't use UNIVERSAL::isa because we want to honor isa() overrides
529 local($@, $!); # eval sometimes resets $!
530 my $rslt = eval { $object->isa($class) };
531 if( $@ ) {
532 if( $@ =~ /^Can't call method "isa" on unblessed reference/ ) {
533 if( !UNIVERSAL::isa($object, $class) ) {
534 my $ref = ref $object;
6686786d 535 $diag = "$obj_name isn't a '$class' it's a '$ref'";
a9153838
MS
536 }
537 } else {
538 die <<WHOA;
539WHOA! I tried to call ->isa on your object and got some weird error.
540This should never happen. Please contact the author immediately.
541Here's the error.
542$@
543WHOA
544 }
545 }
546 elsif( !$rslt ) {
547 my $ref = ref $object;
6686786d 548 $diag = "$obj_name isn't a '$class' it's a '$ref'";
a9153838 549 }
d020a79a 550 }
a9153838
MS
551
552
d020a79a 553
33459055 554 my $ok;
d020a79a 555 if( $diag ) {
33459055 556 $ok = $Test->ok( 0, $name );
a9153838 557 $Test->diag(" $diag\n");
d020a79a
JH
558 }
559 else {
33459055 560 $ok = $Test->ok( 1, $name );
d020a79a 561 }
33459055
MS
562
563 return $ok;
d020a79a
JH
564}
565
566
3f2ec160
JH
567=item B<pass>
568
569=item B<fail>
570
571 pass($test_name);
572 fail($test_name);
573
574Sometimes you just want to say that the tests have passed. Usually
575the case is you've got some complicated condition that is difficult to
576wedge into an ok(). In this case, you can simply use pass() (to
577declare the test ok) or fail (for not ok). They are synonyms for
578ok(1) and ok(0).
579
580Use these very, very, very sparingly.
581
582=cut
583
d020a79a 584sub pass (;$) {
33459055 585 $Test->ok(1, @_);
3f2ec160
JH
586}
587
d020a79a 588sub fail (;$) {
33459055 589 $Test->ok(0, @_);
3f2ec160
JH
590}
591
592=back
593
a9153838
MS
594=head2 Diagnostics
595
596If you pick the right test function, you'll usually get a good idea of
597what went wrong when it failed. But sometimes it doesn't work out
598that way. So here we have ways for you to write your own diagnostic
599messages which are safer than just C<print STDERR>.
600
601=over 4
602
603=item B<diag>
604
605 diag(@diagnostic_message);
606
607Prints a diagnostic message which is guaranteed not to interfere with
608test output. Handy for this sort of thing:
609
610 ok( grep(/foo/, @users), "There's a foo user" ) or
611 diag("Since there's no foo, check that /etc/bar is set up right");
612
613which would produce:
614
615 not ok 42 - There's a foo user
616 # Failed test (foo.t at line 52)
617 # Since there's no foo, check that /etc/bar is set up right.
618
619You might remember C<ok() or diag()> with the mnemonic C<open() or
620die()>.
621
622B<NOTE> The exact formatting of the diagnostic output is still
623changing, but it is guaranteed that whatever you throw at it it won't
624interfere with the test.
625
626=cut
627
628sub diag {
629 $Test->diag(@_);
630}
631
632
633=back
634
3f2ec160
JH
635=head2 Module tests
636
637You usually want to test if the module you're testing loads ok, rather
638than just vomiting if its load fails. For such purposes we have
639C<use_ok> and C<require_ok>.
640
641=over 4
642
643=item B<use_ok>
644
3f2ec160 645 BEGIN { use_ok($module); }
d020a79a
JH
646 BEGIN { use_ok($module, @imports); }
647
648These simply use the given $module and test to make sure the load
89c1e84a 649happened ok. It's recommended that you run use_ok() inside a BEGIN
d020a79a
JH
650block so its functions are exported at compile-time and prototypes are
651properly honored.
652
653If @imports are given, they are passed through to the use. So this:
654
655 BEGIN { use_ok('Some::Module', qw(foo bar)) }
656
657is like doing this:
658
659 use Some::Module qw(foo bar);
3f2ec160 660
a344be10
MS
661don't try to do this:
662
663 BEGIN {
664 use_ok('Some::Module');
665
666 ...some code that depends on the use...
667 ...happening at compile time...
668 }
669
670instead, you want:
671
672 BEGIN { use_ok('Some::Module') }
673 BEGIN { ...some code that depends on the use... }
674
3f2ec160
JH
675
676=cut
677
d020a79a
JH
678sub use_ok ($;@) {
679 my($module, @imports) = @_;
680 @imports = () unless @imports;
3f2ec160
JH
681
682 my $pack = caller;
683
a9153838 684 local($@,$!); # eval sometimes interferes with $!
3f2ec160
JH
685 eval <<USE;
686package $pack;
687require $module;
89c1e84a 688'$module'->import(\@imports);
3f2ec160
JH
689USE
690
33459055 691 my $ok = $Test->ok( !$@, "use $module;" );
3f2ec160
JH
692
693 unless( $ok ) {
0cd946aa 694 chomp $@;
33459055 695 $Test->diag(<<DIAGNOSTIC);
a9153838
MS
696 Tried to use '$module'.
697 Error: $@
3f2ec160
JH
698DIAGNOSTIC
699
700 }
701
702 return $ok;
703}
704
d020a79a
JH
705=item B<require_ok>
706
707 require_ok($module);
708
709Like use_ok(), except it requires the $module.
710
711=cut
3f2ec160
JH
712
713sub require_ok ($) {
714 my($module) = shift;
715
716 my $pack = caller;
717
a9153838 718 local($!, $@); # eval sometimes interferes with $!
3f2ec160
JH
719 eval <<REQUIRE;
720package $pack;
721require $module;
722REQUIRE
723
33459055 724 my $ok = $Test->ok( !$@, "require $module;" );
3f2ec160
JH
725
726 unless( $ok ) {
0cd946aa 727 chomp $@;
33459055 728 $Test->diag(<<DIAGNOSTIC);
a9153838
MS
729 Tried to require '$module'.
730 Error: $@
3f2ec160
JH
731DIAGNOSTIC
732
733 }
734
735 return $ok;
736}
737
d020a79a 738=back
3f2ec160
JH
739
740=head2 Conditional tests
741
742Sometimes running a test under certain conditions will cause the
743test script to die. A certain function or method isn't implemented
744(such as fork() on MacOS), some resource isn't available (like a
d020a79a
JH
745net connection) or a module isn't available. In these cases it's
746necessary to skip tests, or declare that they are supposed to fail
3f2ec160
JH
747but will work in the future (a todo test).
748
a9153838
MS
749For more details on the mechanics of skip and todo tests see
750L<Test::Harness>.
d020a79a
JH
751
752The way Test::More handles this is with a named block. Basically, a
753block of tests which can be skipped over or made todo. It's best if I
754just show you...
3f2ec160
JH
755
756=over 4
757
d020a79a
JH
758=item B<SKIP: BLOCK>
759
760 SKIP: {
761 skip $why, $how_many if $condition;
3f2ec160 762
d020a79a
JH
763 ...normal testing code goes here...
764 }
3f2ec160 765
a344be10
MS
766This declares a block of tests that might be skipped, $how_many tests
767there are, $why and under what $condition to skip them. An example is
768the easiest way to illustrate:
3f2ec160 769
d020a79a 770 SKIP: {
a344be10 771 eval { require HTML::Lint };
3f2ec160 772
a344be10 773 skip "HTML::Lint not installed", 2 if $@;
d020a79a 774
a344be10 775 my $lint = new HTML::Lint;
60ffb308 776 isa_ok( $lint, "HTML::Lint" );
3f2ec160 777
a344be10 778 $lint->parse( $html );
60ffb308 779 is( $lint->errors, 0, "No errors found in HTML" );
a344be10 780 }
d020a79a 781
a344be10
MS
782If the user does not have HTML::Lint installed, the whole block of
783code I<won't be run at all>. Test::More will output special ok's
784which Test::Harness interprets as skipped, but passing, tests.
785It's important that $how_many accurately reflects the number of tests
786in the SKIP block so the # of tests run will match up with your plan.
a9153838 787
a344be10
MS
788It's perfectly safe to nest SKIP blocks. Each SKIP block must have
789the label C<SKIP>, or Test::More can't work its magic.
a9153838
MS
790
791You don't skip tests which are failing because there's a bug in your
a344be10
MS
792program, or for which you don't yet have code written. For that you
793use TODO. Read on.
3f2ec160
JH
794
795=cut
796
d020a79a 797#'#
1af51bd3 798sub skip {
d020a79a 799 my($why, $how_many) = @_;
33459055
MS
800
801 unless( defined $how_many ) {
d020a79a 802 # $how_many can only be avoided when no_plan is in use.
33459055
MS
803 _carp "skip() needs to know \$how_many tests are in the block"
804 unless $Test::Builder::No_Plan;
d020a79a
JH
805 $how_many = 1;
806 }
807
808 for( 1..$how_many ) {
33459055 809 $Test->skip($why);
d020a79a
JH
810 }
811
812 local $^W = 0;
813 last SKIP;
3f2ec160
JH
814}
815
3f2ec160 816
d020a79a 817=item B<TODO: BLOCK>
3f2ec160 818
d020a79a 819 TODO: {
a9153838 820 local $TODO = $why if $condition;
3f2ec160 821
d020a79a
JH
822 ...normal testing code goes here...
823 }
3f2ec160 824
d020a79a
JH
825Declares a block of tests you expect to fail and $why. Perhaps it's
826because you haven't fixed a bug or haven't finished a new feature:
3f2ec160 827
d020a79a
JH
828 TODO: {
829 local $TODO = "URI::Geller not finished";
3f2ec160 830
d020a79a
JH
831 my $card = "Eight of clubs";
832 is( URI::Geller->your_card, $card, 'Is THIS your card?' );
3f2ec160 833
d020a79a
JH
834 my $spoon;
835 URI::Geller->bend_spoon;
836 is( $spoon, 'bent', "Spoon bending, that's original" );
837 }
838
839With a todo block, the tests inside are expected to fail. Test::More
840will run the tests normally, but print out special flags indicating
841they are "todo". Test::Harness will interpret failures as being ok.
842Should anything succeed, it will report it as an unexpected success.
a344be10
MS
843You then know the thing you had todo is done and can remove the
844TODO flag.
d020a79a
JH
845
846The nice part about todo tests, as opposed to simply commenting out a
4bd4e70a 847block of tests, is it's like having a programmatic todo list. You know
d020a79a
JH
848how much work is left to be done, you're aware of what bugs there are,
849and you'll know immediately when they're fixed.
850
851Once a todo test starts succeeding, simply move it outside the block.
852When the block is empty, delete it.
853
854
a9153838
MS
855=item B<todo_skip>
856
857 TODO: {
858 todo_skip $why, $how_many if $condition;
859
860 ...normal testing code...
861 }
862
89c1e84a 863With todo tests, it's best to have the tests actually run. That way
a9153838
MS
864you'll know when they start passing. Sometimes this isn't possible.
865Often a failing test will cause the whole program to die or hang, even
866inside an C<eval BLOCK> with and using C<alarm>. In these extreme
867cases you have no choice but to skip over the broken tests entirely.
868
869The syntax and behavior is similar to a C<SKIP: BLOCK> except the
870tests will be marked as failing but todo. Test::Harness will
871interpret them as passing.
872
873=cut
874
875sub todo_skip {
876 my($why, $how_many) = @_;
877
878 unless( defined $how_many ) {
879 # $how_many can only be avoided when no_plan is in use.
880 _carp "todo_skip() needs to know \$how_many tests are in the block"
881 unless $Test::Builder::No_Plan;
882 $how_many = 1;
883 }
884
885 for( 1..$how_many ) {
886 $Test->todo_skip($why);
887 }
888
889 local $^W = 0;
890 last TODO;
891}
892
a344be10
MS
893=item When do I use SKIP vs. TODO?
894
895B<If it's something the user might not be able to do>, use SKIP.
896This includes optional modules that aren't installed, running under
897an OS that doesn't have some feature (like fork() or symlinks), or maybe
898you need an Internet connection and one isn't available.
899
900B<If it's something the programmer hasn't done yet>, use TODO. This
901is for any code you haven't written yet, or bugs you have yet to fix,
902but want to put tests in your testing script (always a good idea).
903
a9153838 904
d020a79a 905=back
3f2ec160 906
4bd4e70a 907=head2 Comparison functions
3f2ec160
JH
908
909Not everything is a simple eq check or regex. There are times you
910need to see if two arrays are equivalent, for instance. For these
911instances, Test::More provides a handful of useful functions.
912
913B<NOTE> These are NOT well-tested on circular references. Nor am I
914quite sure what will happen with filehandles.
915
916=over 4
917
33459055
MS
918=item B<is_deeply>
919
920 is_deeply( $this, $that, $test_name );
921
922Similar to is(), except that if $this and $that are hash or array
923references, it does a deep comparison walking each data structure to
924see if they are equivalent. If the two structures are different, it
925will display the place where they start differing.
926
a9153838
MS
927Barrie Slaymaker's Test::Differences module provides more in-depth
928functionality along these lines, and it plays well with Test::More.
929
33459055
MS
930B<NOTE> Display of scalar refs is not quite 100%
931
932=cut
933
934use vars qw(@Data_Stack);
935my $DNE = bless [], 'Does::Not::Exist';
936sub is_deeply {
937 my($this, $that, $name) = @_;
938
939 my $ok;
582cb20e 940 if( !ref $this && !ref $that ) {
33459055
MS
941 $ok = $Test->is_eq($this, $that, $name);
942 }
943 else {
944 local @Data_Stack = ();
945 if( _deep_check($this, $that) ) {
946 $ok = $Test->ok(1, $name);
947 }
948 else {
949 $ok = $Test->ok(0, $name);
950 $ok = $Test->diag(_format_stack(@Data_Stack));
951 }
952 }
953
954 return $ok;
955}
956
957sub _format_stack {
958 my(@Stack) = @_;
959
960 my $var = '$FOO';
961 my $did_arrow = 0;
962 foreach my $entry (@Stack) {
963 my $type = $entry->{type} || '';
964 my $idx = $entry->{'idx'};
965 if( $type eq 'HASH' ) {
966 $var .= "->" unless $did_arrow++;
967 $var .= "{$idx}";
968 }
969 elsif( $type eq 'ARRAY' ) {
970 $var .= "->" unless $did_arrow++;
971 $var .= "[$idx]";
972 }
973 elsif( $type eq 'REF' ) {
974 $var = "\${$var}";
975 }
976 }
977
978 my @vals = @{$Stack[-1]{vals}}[0,1];
979 my @vars = ();
980 ($vars[0] = $var) =~ s/\$FOO/ \$got/;
981 ($vars[1] = $var) =~ s/\$FOO/\$expected/;
982
983 my $out = "Structures begin differing at:\n";
984 foreach my $idx (0..$#vals) {
985 my $val = $vals[$idx];
986 $vals[$idx] = !defined $val ? 'undef' :
582cb20e
FD
987 ref $val ? $val eq $DNE ? "Does not exist"
988 : $val
989 : "'$val'"
33459055
MS
990 }
991
992 $out .= "$vars[0] = $vals[0]\n";
993 $out .= "$vars[1] = $vals[1]\n";
994
a9153838 995 $out =~ s/^/ /msg;
33459055
MS
996 return $out;
997}
998
582cb20e
FD
999sub eq_deeply {
1000 my ($a1, $a2) = @_;
1001
1002 local @Data_Stack = ();
1003 return _deep_check($a1, $a2);
1004}
33459055 1005
3f2ec160
JH
1006=item B<eq_array>
1007
1008 eq_array(\@this, \@that);
1009
1010Checks if two arrays are equivalent. This is a deep check, so
1011multi-level structures are handled correctly.
1012
1013=cut
1014
1015#'#
582cb20e
FD
1016
1017sub eq_array {
1018 my ($a1, $a2) = @_;
1019
1020 return UNIVERSAL::isa($a2, "ARRAY") ? eq_deeply($a1, $a2) : 0;
1021}
1022
1023sub _eq_array {
3f2ec160 1024 my($a1, $a2) = @_;
3f2ec160
JH
1025 return 1 if $a1 eq $a2;
1026
1027 my $ok = 1;
33459055
MS
1028 my $max = $#$a1 > $#$a2 ? $#$a1 : $#$a2;
1029 for (0..$max) {
1030 my $e1 = $_ > $#$a1 ? $DNE : $a1->[$_];
1031 my $e2 = $_ > $#$a2 ? $DNE : $a2->[$_];
1032
1033 push @Data_Stack, { type => 'ARRAY', idx => $_, vals => [$e1, $e2] };
3f2ec160 1034 $ok = _deep_check($e1,$e2);
33459055
MS
1035 pop @Data_Stack if $ok;
1036
3f2ec160
JH
1037 last unless $ok;
1038 }
1039 return $ok;
1040}
1041
1042sub _deep_check {
1043 my($e1, $e2) = @_;
1044 my $ok = 0;
1045
d020a79a
JH
1046 my $eq;
1047 {
4bd4e70a 1048 # Quiet uninitialized value warnings when comparing undefs.
d020a79a
JH
1049 local $^W = 0;
1050
582cb20e 1051 if( ! (ref $e1 xor ref $e2) and $e1 eq $e2 ) {
d020a79a 1052 $ok = 1;
3f2ec160
JH
1053 }
1054 else {
582cb20e
FD
1055 if ( (ref $e1 and $e1 eq $DNE) or
1056 (ref $e2 and $e2 eq $DNE) )
1057 {
1058 $ok = 0;
1059 }
1060 elsif( UNIVERSAL::isa($e1, 'ARRAY') and
d020a79a
JH
1061 UNIVERSAL::isa($e2, 'ARRAY') )
1062 {
582cb20e 1063 $ok = _eq_array($e1, $e2);
d020a79a
JH
1064 }
1065 elsif( UNIVERSAL::isa($e1, 'HASH') and
1066 UNIVERSAL::isa($e2, 'HASH') )
1067 {
582cb20e 1068 $ok = _eq_hash($e1, $e2);
d020a79a 1069 }
33459055
MS
1070 elsif( UNIVERSAL::isa($e1, 'REF') and
1071 UNIVERSAL::isa($e2, 'REF') )
1072 {
1073 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1074 $ok = _deep_check($$e1, $$e2);
1075 pop @Data_Stack if $ok;
1076 }
1077 elsif( UNIVERSAL::isa($e1, 'SCALAR') and
1078 UNIVERSAL::isa($e2, 'SCALAR') )
1079 {
1080 push @Data_Stack, { type => 'REF', vals => [$e1, $e2] };
1081 $ok = _deep_check($$e1, $$e2);
582cb20e 1082 pop @Data_Stack if $ok;
33459055 1083 }
d020a79a 1084 else {
33459055 1085 push @Data_Stack, { vals => [$e1, $e2] };
d020a79a
JH
1086 $ok = 0;
1087 }
3f2ec160
JH
1088 }
1089 }
d020a79a 1090
3f2ec160
JH
1091 return $ok;
1092}
1093
1094
1095=item B<eq_hash>
1096
1097 eq_hash(\%this, \%that);
1098
1099Determines if the two hashes contain the same keys and values. This
1100is a deep check.
1101
1102=cut
1103
1104sub eq_hash {
582cb20e
FD
1105 my ($a1, $a2) = @_;
1106
1107 return UNIVERSAL::isa($a2, "HASH") ? eq_deeply($a1, $a2) : 0;
1108}
1109
1110sub _eq_hash {
3f2ec160 1111 my($a1, $a2) = @_;
3f2ec160
JH
1112 return 1 if $a1 eq $a2;
1113
1114 my $ok = 1;
33459055
MS
1115 my $bigger = keys %$a1 > keys %$a2 ? $a1 : $a2;
1116 foreach my $k (keys %$bigger) {
1117 my $e1 = exists $a1->{$k} ? $a1->{$k} : $DNE;
1118 my $e2 = exists $a2->{$k} ? $a2->{$k} : $DNE;
1119
1120 push @Data_Stack, { type => 'HASH', idx => $k, vals => [$e1, $e2] };
3f2ec160 1121 $ok = _deep_check($e1, $e2);
33459055
MS
1122 pop @Data_Stack if $ok;
1123
3f2ec160
JH
1124 last unless $ok;
1125 }
1126
1127 return $ok;
1128}
1129
1130=item B<eq_set>
1131
1132 eq_set(\@this, \@that);
1133
1134Similar to eq_array(), except the order of the elements is B<not>
1135important. This is a deep check, but the irrelevancy of order only
1136applies to the top level.
1137
60ffb308
MS
1138B<NOTE> By historical accident, this is not a true set comparision.
1139While the order of elements does not matter, duplicate elements do.
1140
3f2ec160
JH
1141=cut
1142
1143# We must make sure that references are treated neutrally. It really
1144# doesn't matter how we sort them, as long as both arrays are sorted
1145# with the same algorithm.
d020a79a 1146sub _bogus_sort { local $^W = 0; ref $a ? 0 : $a cmp $b }
3f2ec160
JH
1147
1148sub eq_set {
1149 my($a1, $a2) = @_;
1150 return 0 unless @$a1 == @$a2;
1151
1152 # There's faster ways to do this, but this is easiest.
1153 return eq_array( [sort _bogus_sort @$a1], [sort _bogus_sort @$a2] );
1154}
1155
3f2ec160
JH
1156=back
1157
d020a79a 1158
a9153838 1159=head2 Extending and Embedding Test::More
d020a79a 1160
a9153838
MS
1161Sometimes the Test::More interface isn't quite enough. Fortunately,
1162Test::More is built on top of Test::Builder which provides a single,
1163unified backend for any test library to use. This means two test
1164libraries which both use Test::Builder B<can be used together in the
1165same program>.
1166
1167If you simply want to do a little tweaking of how the tests behave,
1168you can access the underlying Test::Builder object like so:
3f2ec160 1169
d020a79a
JH
1170=over 4
1171
a9153838 1172=item B<builder>
d020a79a 1173
a9153838 1174 my $test_builder = Test::More->builder;
d020a79a 1175
a9153838
MS
1176Returns the Test::Builder object underlying Test::More for you to play
1177with.
1178
1179=cut
d020a79a 1180
a9153838
MS
1181sub builder {
1182 return Test::Builder->new;
1183}
d020a79a 1184
a9153838 1185=back
3f2ec160 1186
d020a79a 1187
a9153838
MS
1188=head1 NOTES
1189
1190Test::More is B<explicitly> tested all the way back to perl 5.004.
d020a79a 1191
a344be10
MS
1192Test::More is thread-safe for perl 5.8.0 and up.
1193
a9153838
MS
1194=head1 BUGS and CAVEATS
1195
1196=over 4
1197
1198=item Making your own ok()
1199
1200If you are trying to extend Test::More, don't. Use Test::Builder
1201instead.
1202
1203=item The eq_* family has some caveats.
d020a79a
JH
1204
1205=item Test::Harness upgrades
3f2ec160 1206
d020a79a 1207no_plan and todo depend on new Test::Harness features and fixes. If
a9153838
MS
1208you're going to distribute tests that use no_plan or todo your
1209end-users will have to upgrade Test::Harness to the latest one on
1210CPAN. If you avoid no_plan and TODO tests, the stock Test::Harness
1211will work fine.
d020a79a
JH
1212
1213If you simply depend on Test::More, it's own dependencies will cause a
1214Test::Harness upgrade.
1215
1216=back
3f2ec160 1217
3f2ec160
JH
1218
1219=head1 HISTORY
1220
1221This is a case of convergent evolution with Joshua Pritikin's Test
4bd4e70a 1222module. I was largely unaware of its existence when I'd first
3f2ec160
JH
1223written my own ok() routines. This module exists because I can't
1224figure out how to easily wedge test names into Test's interface (along
1225with a few other problems).
1226
1227The goal here is to have a testing utility that's simple to learn,
1228quick to use and difficult to trip yourself up with while still
1229providing more flexibility than the existing Test.pm. As such, the
1230names of the most common routines are kept tiny, special cases and
1231magic side-effects are kept to a minimum. WYSIWYG.
1232
1233
1234=head1 SEE ALSO
1235
1236L<Test::Simple> if all this confuses you and you just want to write
89c1e84a 1237some tests. You can upgrade to Test::More later (it's forward
3f2ec160
JH
1238compatible).
1239
a9153838
MS
1240L<Test::Differences> for more ways to test complex data structures.
1241And it plays well with Test::More.
1242
1243L<Test> is the old testing module. Its main benefit is that it has
1244been distributed with Perl since 5.004_05.
3f2ec160
JH
1245
1246L<Test::Harness> for details on how your test results are interpreted
1247by Perl.
1248
1249L<Test::Unit> describes a very featureful unit testing interface.
1250
4bd4e70a 1251L<Test::Inline> shows the idea of embedded testing.
3f2ec160
JH
1252
1253L<SelfTest> is another approach to embedded testing.
1254
4bd4e70a
JH
1255
1256=head1 AUTHORS
1257
a9153838
MS
1258Michael G Schwern E<lt>schwern@pobox.comE<gt> with much inspiration
1259from Joshua Pritikin's Test module and lots of help from Barrie
1260Slaymaker, Tony Bowden, chromatic and the perl-qa gang.
4bd4e70a
JH
1261
1262
1263=head1 COPYRIGHT
1264
1265Copyright 2001 by Michael G Schwern E<lt>schwern@pobox.comE<gt>.
1266
1267This program is free software; you can redistribute it and/or
1268modify it under the same terms as Perl itself.
1269
a9153838 1270See F<http://www.perl.com/perl/misc/Artistic.html>
4bd4e70a 1271
3f2ec160
JH
1272=cut
1273
12741;